home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / t_os / ampaint / ampaint.bas next >
BASIC Source File  |  1991-10-18  |  82KB  |  1,234 lines
  1. 5 CLEAR ,,512,900000,11648
  2. 10 DEFINT A-Z:VERS$="0.98h":VDATE$="91/09/06":GC=0:BASICCOMPILERORINTERPRITERCHECKFLAGVALUE1=1:BASICCOMPILERORINTERPRITERCHECKFLAGVALUE0=0:BICF=BASICCOMPILERORINTERPRITERCHECKFLAGVALUE1
  3. 20 DIM GB%(163839),WG%(38399),MG%(38399),MGB%(38399),CM%(5985),PP%(15),PPC%(127),BUT%(50,3),BV%(50,1),GC%(9),PSP%(927),HSP%(927),PSP2%(7423),PSP3%(7423),PAL%(255,3),FLG%(721,3),GAV%(255),RAV%(255),BAV%(255),CDDAT%(10),CDT%(3),CP&(127),WFP%(8191)
  4. 25 DIM EF1%(927),EF2%(927),EF3%(927),EF4%(927),GS!(32),STMP%(23039),STP0%(3839),CUTP%(19199),WPP%(3),PALO%(255,3)
  5. 28 DIM STPM0%(63),STPM1%(63),STPM2%(63),STPM3%(63),STPM4%(63),STPM5%(63),STPM6%(63),STPM7%(63),STPM8%(63),STPM9%(63),STPM10%(63),STPM11%(63),STPM12%(63),STPM13%(63),STPM14%(63)
  6. 30 DIM FILE_NAME$(256),RADBUT$(9),RETFLG(9),XY(20,4),WC(12) 'for File Dialog
  7. 40 DEF FNFF$(F$)=LEFT$(KLEFT$(F$,KINSTR(F$+"        .",".")-1)+SPACE$(8),8)+LEFT$(KMID$(F$,KINSTR(F$+"        .","."),4)+SPACE$(4),4):DEF FNF$(F)=RIGHT$("  "+STR$(F),3):DEF FNMP$(A&)=MID$(MKL$(A& AND &HFFFF00),2,2)
  8. 45 DEF FNP1$(A&)=CHR$(A& AND &HFF):DEF FNP2$(A&)=CHR$((A& AND &HFF00)\256):
  9. 50 OFFSET&=0:FDX=16:FDY=2:FDXM=FDX*8:FDYM=FDY*19:MAXCMD=12:CANCMD=9:BUTCMD=12:RADBUT=10:RCMD=0:WC$="*.*":TM$=SPACE$(8):FDM$=SPACE$(68):RIFLG=0:BASCOM=BICF
  10. 60 INFOR$=STRING$(200,0):DIR$=SPACE$(65):DRV_SET$=STRING$(26,0):FILENAME$=SPACE$(15):KAKUNO$=FILENAME$:PATH_ALL$=WC$:DUMMYY$=SPACE$(14):DUMMYP$="."+CHR$(0):FOR A=0 TO 256:FILE_NAME$(A)=SPACE$(16):NEXT:FOR A=0 TO 9:RADBUT$(A)=SPACE$(60):NEXT
  11. 70 PATH$=SPACE$(255):DRIVE$=SPACE$(255):F_NAME$=SPACE$(255)
  12. 80 GOSUB *INIT:GOSUB *ABOUT_WRT:ON KEY(6) GOSUB *NZF:KEY(6) ON::ON KEY(7) GOSUB *STPAD:KEY(7) ON:LOADM ".\BAS2BIOS.REX",OFFSET&
  13. 85  ON KEY (1) GOSUB *CDSTART:ON KEY (2) GOSUB *CDSTOP:ON KEY (3) GOSUB *CDPAUSE:ON KEY (4) GOSUB *CDCONT:ON KEY (9) GOSUB *CDPREV:ON KEY (10) GOSUB *CDNEXT:KEY(1) ON:KEY(2) ON:KEY(3) ON:KEY(4) ON:KEY(9) ON:KEY(10) ON
  14. 90 WAIT 100:GOSUB *PAL_INI:PUT@A (MENX,0)-(MENX+159,479),MG%:GOSUB *COLDISP:GOSUB *FLGINI:GOSUB *MOS_INI:GOSUB *EVENT_LOOP
  15. 100 '
  16. 110 END
  17. 120 *MOS_INI:MOUSE 0:MOUSE 1,,,1:RETURN
  18. 130 *MOS_WAIT:WHILE MOUSE(2,0)=0:GOSUB *PAL_SHIFT:WEND:RETURN
  19. 180 *STPAD:STP=STP+1:IF STP>32 THEN STP=1:RETURN ELSE RETURN
  20. 190 *NZF:NZF=1-NZF:RETURN
  21. 200 *INIT
  22. 210  GOSUB *CAMGET:SCREEN@ 2:PALETTE:COLOR ,,7:GOSUB *VW0:LINE (0,0)-(1023,511),PSET,%255,BF:GET@A (0,0)-(159,479),MGB%
  23. 215  LOAD@ ".\MENU.TIF":GET@A (0,0)-(159,479),MG%:GET@A (6,367)-(151,448),CM%:LOAD@ ".\menu2.tif",(640,0):LOAD@ ".\menu3.tif",(640,208)
  24. 220 GET@ (641,1)-(784,103),PSP%,%GC:GET@ (641,105)-(784,207),HSP%,%GC:GET@A (641,209)-(784,311),PSP2%:GET@A (641,313)-(784,415),PSP3%
  25. 222 LOAD@ ".\menu4.tif",(640,0):GET@ (641,1)-(784,103),EF1%,%GC:GET@ (641,105)-(784,207),EF2%,%GC:GET@ (641,209)-(784,311),EF3%,%GC:GET@ (641,313)-(784,415),EF4%,%GC:EF=4
  26. 223 LOAD@ ".\menu5.tif",(960,0):GET@A (928,0)-(1023,479),STMP% '32パターンを4つ登録した場合は､TIFFファイルを928からロード
  27. 225 CMDV=0:MENX=0:COLV=0:PALF=1:SP=1:WREF=0:DOF=8:PS=16:MDV=9:FOR A=0 TO 15:PP%(A)=-1:NEXT:GOSUB *COLDISP:EX=170:EY=200:FOR A=0 TO 255:GAV%(A)=-1:RAV%(A)=1:BAV%(A)=-1:NEXT:PST=1:STP=20:NZF=0:PCHG=3:BWF=0:PCF=0:WFV=1:WFCMD=1:UNDOV=23
  28. 230 RESTORE *B_DATA:READ CMDN:FOR A=0 TO CMDN-1:FOR B=0 TO 3:READ BUT%(A,B):NEXT:READ BV%(A,0):READ BV%(A,1):NEXT:GOSUB *CDSTART:RETURN
  29. 240 *FLGINI:FOR A=1 TO 4:GET@A (BUT%(A,0),BUT%(A,1))-(BUT%(A,2),BUT%(A,3)),FLG%,722*(A-1):NEXT:FLG%=1:YN=PALF:GOSUB *FLGSW:FLG%=2:YN=SP:GOSUB *FLGSW:FLG%=3:YN=WREF:GOSUB *FLGSW:RETURN 'FLG%=4:YN=FLG4:GOSUB *FLGSW:RETURN
  30. 250 *B_DATA:DATA 30, 0,0,159,41,1,0, 3,51,40,88,13,0, 41,51,78,88,12,0, 79,51,116,88,22,0, 117,51,154,88,0,0
  31. 260 DATA 3,96,40,133,5,1, 41,96,78,133,6,1, 79,96,116,133,7,1, 117,96,154,133,9,1, 3,141,40,178,15,1, 41,141,78,178,16,1, 79,141,116,178,8,1, 117,141,154,178,21,1, 3,186,40,223,24,0, 41,186,78,223,0,0, 79,186,116,223,0,0, 117,186,154,223,0,0
  32. 270 DATA 3,231,40,268,20,0, 41,231,78,268,0,0, 79,231,116,268,23,0, 117,231,154,268,11,0, 3,276,40,313,14,0, 41,276,78,313,17,0, 79,276,116,313,18,0, 117,276,154,313,19,0, 3,321,40,358,4,0, 41,321,78,358,3,0, 79,321,116,358,0,0, 117,321,154,358,2,0
  33. 280 DATA 6,367,151,471,10,0
  34. 300 *ABOUT
  35. 310 GET@A (MENX,0)-(MENX+159,479),MG%:GOSUB *ABOUT_WRT:WHILE MOUSE(2,0)=0:GOSUB *PAL_SHIFT:WEND:WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND:PUT@A (MENX,0)-(MENX+159,479),MG%:GOSUB *UNDOCMD:RETURN
  36. 350 *ABOUT_WRT
  37. 360 LINE (MENX,41)-(MENX+159,479),PSET,0,BF,&HFF00FF00FF00FF0000FF00FF00FF00FF:LINE (MENX+2,43)-(MENX+157,477),PSET,7,BF,0
  38. 370 SYMBOL (MENX+20,60),"Version "+VERS$,1,1,%245:SYMBOL (MENX+60,80),VDATE$,1,1,%245
  39. 380 SYMBOL (MENX+4,120),"(C)1991-",1,1,%200:SYMBOL (MENX+6,140),"Studio",1,1,%200:SYMBOL (MENX+2,160)," Aspergillus Valley",1,1,%200:SYMBOL (MENX+18,180),"& おくと-OcToh-",1,1,%200
  40. 390 SYMBOL (MENX+4,200),"All Programming",1,1,%180:SYMBOL (MENX+28,220),"by おくと-OcToh-",1,1,%180
  41. 400 SYMBOL (MENX+12,280),"  このエディタは､",1,1,%140:SYMBOL (MENX+12,300),"描くことを楽しむ",1,1,%140:SYMBOL (MENX+12,320),"ためのソフトです｡",1,1,%140
  42. 410 SYMBOL (MENX+12,340),"  失敗など気にしな",1,1,%140:SYMBOL (MENX+12,360),"いで、気軽にマウス",1,1,%140:SYMBOL (MENX+12,380),"を動かしましょう｡",1,1,%140
  43. 420 SYMBOL (MENX+12,420),"Let's Joyful",1,1,%25:SYMBOL (MENX+84,440),"Painting!",1,1,%25:IF BICF=1 THEN M$=" F-BASIC386コンパイラ版" ELSE M$="F-BASIC386インタプリタ版"
  44. 430 SYMBOL (MENX+8,461),M$,.75!,1,%245
  45. 490 RETURN
  46. 500 *COLDISP:LINE (MENX+7,368)-(MENX+150,470),PSET,%COLV,BF:RETURN
  47. 510 *COLDISP2:LINE (MENX+7,449)-(MENX+150,470),PSET,%COLV,BF:RETURN
  48. 520 *MENUOFF:GET@A (MENX,0)-(MENX+159,479),MG%:PUT@A (MENX,0)-(MENX+159,479),MGB%:RETURN
  49. 530 *MENUWRT:GET@A (MENX,0)-(MENX+159,479),MGB%:PUT@A (MENX,0)-(MENX+159,479),MG%:RETURN
  50. 540 *MENUMOVE:GOSUB *MENUOFF:MENX=480-MENX:GOSUB *MENUWRT:RETURN
  51. 550 *UNDOCMD:CMDV=OCMDV:STF=OSTF:RETURN
  52. 560 *MXY:MX=MOUSE(0)+(INT(RND(1)*39)-20)*WREF:MY=MOUSE(1)+RND(1)*WREF+(INT(RND(1)*39)-20)*WREF
  53. 570 IF MX<0 THEN MX=0 ELSE IF MX>639 THEN MX=639
  54. 580 IF MY<0 THEN MY=0 ELSE IF MY>479 THEN MY=479
  55. 590 RETURN
  56. 600 *WRTDOT
  57. 610 GOSUB *MXY:IF PCF=0 THEN PUT@ (MX-DOF,MY-DOF)-(MX-DOF+15,MY-DOF+15),PP%,PSET,%COLV ELSE PUT@A (MX-DOF,MY-DOF)-(MX-DOF+15,MY-DOF+15),PPC%,MATTE,,,%255
  58. 620 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  59. 630 RETURN
  60. 650 *WRTDOT3
  61. 660 GOSUB *MXY:PSET (MX,MY),%COLV
  62. 670 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  63. 680 RETURN
  64. 700 *WRTLINE2
  65. 710 GOSUB *MXY:LINE -(MX,MY),PSET,%COLV
  66. 720 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  67. 730 RETURN
  68. 750 *WRTDOT2
  69. 760 GOSUB *WRTDOT:LDX2=MX:LDY2=MY
  70. 770 RETURN
  71. 800 *WRTLINE
  72. 810 LDX1=LDX2:LDY1=LDY2:GOSUB *MXY:LDX2=MX:LDY2=MY:GOSUB *LINE_DRAW
  73. 820 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  74. 830 RETURN
  75. 850 *PSET
  76. 860 IF PCF=0 THEN PUT@ (X-DOF,Y-DOF)-(X-DOF+15,Y-DOF+15),PP%,PSET,%COLV ELSE PUT@A (X-DOF,Y-DOF)-(X-DOF+15,Y-DOF+15),PPC%,MATTE,,,%255
  77. 870 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  78. 880 RETURN
  79. 1000 *EVENT_LOOP:MOUSE 1,,,1:A=MOUSE(6,0):A&=FRE(1):A&=CALLM(OFFSET&,8):IF (A& AND 2)=2 THEN LINE (MENX+8,460)-(MENX+149,469),PSET,0,BF:SYMBOL (MENX+8,461),RIGHT$("              "+STR$(FRE(1)),14)+"free",1,.5!,7
  80. 1010 WHILE MOUSE(2,0)=0:IF MOUSE(2,1)<>0 THEN WHILE MOUSE(6,1)=0:WEND:GOSUB *MENUMOVE
  81. 1020  GOSUB *PAL_SHIFT:GOSUB *CDCHK
  82. 1030  'GOSUB *DO_FLG
  83. 1090 WEND:GOSUB *MENUCHK:IF YN=1 THEN WHILE MOUSE(6,0)=0:WEND ELSE 1510
  84. 1500 MX=MOUSE(0):MY=MOUSE(1):GOSUB *CHECK_BUTTON
  85. 1510 ON CMDV+1 GOSUB *LOOP_RET,*ABOUT,*EXIT,*LOAD,*SAVE,*DOT_MODE,*LINE_MODE,*FREE_MODE,*PAINT_MODE,*ERASER_MODE,*COLOR,*CLS,*SPFLG,*PALFLG,*PENSIZE,*BOX,*BOX_FILL,*PENPATTERN,*COLORPEN,*COLORPEN2,*EFFECT,*STAMP,*WREFLG,*UNDO,*TEXT
  86. 1520 *LOOP_RET:GOSUB *COLDISP:GOTO *EVENT_LOOP
  87. 1600 *CHECK_BUTTON:OCMDV=CMDV:OSTF=STF:CMDV=0:C=0:MX=MX-MENX:IF BWF=1 THEN LINE (BCX0+MENX,BCY0)-(BCX1+MENX,BCY1),XOR,7,BF:BWF=0
  88. 1610 FOR A=0 TO CMDN-1
  89. 1620  IF BUT%(A,0)=<MX AND BUT%(A,1)=<MY AND BUT%(A,2)=>MX AND BUT%(A,3)=>MY THEN CMDV=BV%(A,0):C=A:A=CMDN:STF=0
  90. 1630 NEXT:IF CMDV<>0 AND (BV%(C,1) AND 3)=1 THEN LINE (BUT%(C,0)+MENX,BUT%(C,1))-(BUT%(C,2)+MENX,BUT%(C,3)),XOR,7,BF:BCX0=BUT%(C,0):BCY0=BUT%(C,1):BCX1=BUT%(C,2):BCY1=BUT%(C,3):CMDFLG=C:BWF=1
  91. 1640 IF CMDV<>0 AND (BV%(C,1) AND 3)<>1 THEN LINE (BCX0+MENX,BCY0)-(BCX1+MENX,BCY1),XOR,7,BF:BWF=1
  92. 1650 RETURN 
  93. 1700 *MENUCHK
  94. 1710 MX=MOUSE(0):IF MENX=0 THEN 1730
  95. 1720  IF 480>MX THEN YN=0:RETURN ELSE YN=1:RETURN
  96. 1730  IF 160<MX THEN YN=0:RETURN ELSE YN=1:RETURN
  97. 2000 *EXIT:GET@A (0,0)-(639,511),GB%:GOSUB *ERR_GET_PIC:ERRV=0:M$="AmazingPAINTを終了します":GOSUB *TORIJIK:IF YN=0 THEN RETURN ELSE END
  98. 2300 *VW0:VIEW (0,0)-(1023,511):WINDOW (0,0)-(1023,511):RETURN
  99. 2310 *VW1:VIEW (0,0)-(1023,479):WINDOW (0,0)-(1023,479):RETURN
  100. 2320 *VW2:VIEW (0,0)-(639,511):WINDOW (0,0)-(639,511):RETURN
  101. 2330 *VW3:VIEW (0,0)-(639,479):WINDOW (0,0)-(639,479):RETURN
  102. 2400 *UNDO:GOSUB *MENUOFF:GOSUB *EXCHG_BUF:GOSUB *MENUWRT:GOSUB *UNDOCMD:RETURN
  103. 2450 *UNDOGET:GOSUB *MENUOFF:GET@A (0,0)-(639,479),GB%:RETURN
  104. 2500 *LOAD:GOSUB *UNDOGET:GOSUB *FILELOAD:GOSUB *MENUWRT:GOSUB *UNDOCMD:RETURN
  105. 2600 *SAVE:GOSUB *UNDOGET:GOSUB *FILESAVE:GOSUB *MENUWRT:GOSUB *UNDOCMD:RETURN
  106. 3000 *DOT_MODE:GOSUB *UNDOGET
  107. 3010 GOSUB *MOS_WAIT:MOUSE 1,,,0:WHILE MOUSE(6,0)=0:GOSUB *WRTDOT:GOSUB *PAL_SHIFT:WEND
  108. 3020 GOSUB *MENUWRT:RETURN
  109. 3500 *LINE_MODE:OWREF=0:SWAP OWREF,WREF:GOSUB *UNDOGET
  110. 3510 GOSUB *MOS_WAIT:WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND:GOSUB *WRTDOT2:GOSUB *WRT_LINE
  111. 3520 GOSUB *MENUWRT:SWAP OWREF,WREF:RETURN
  112. 3600 *WRT_LINE
  113. 3610 GOSUB *MOS_WAIT:WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND:A=MOUSE(3,0):GOSUB *WRTLINE:WAIT 30:IF MOUSE(3,0)=0 THEN *WRT_LINE ELSE IF MX<>MOUSE(0) OR MY<>MOUSE(1) THEN *WRT_LINE ELSE WHILE MOUSE(6,0)=0:WEND
  114. 3620 RETURN
  115. 4000 *FREE_MODE:GOSUB *UNDOGET
  116. 4010 GOSUB *MOS_WAIT:MOUSE 1,,,0:GOSUB *WRTDOT2:WHILE MOUSE(6,0)=0:GOSUB *WRTLINE:GOSUB *PAL_SHIFT:WEND
  117. 4020 GOSUB *MENUWRT:RETURN
  118. 4500 *PAINT_MODE:GOSUB *UNDOGET
  119. 4510 GOSUB *MOS_WAIT:WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND:MX=MOUSE(0):MY=MOUSE(1):PAINT@ (MX,MY),%COLV
  120. 4520 GOSUB *MENUWRT:RETURN
  121. 5000 *ERASER_MODE:OCOLV=255:SWAP OCOLV,COLV:OSP=0:SWAP OSP,SP
  122. 5010 GOSUB *DOT_MODE:COLV=OCOLV:SP=OSP
  123. 5020 RETURN
  124. 5500 *COLOR:GOSUB *COL_MENU
  125. 5510 GOSUB *MOS_WAIT
  126. 5520 WHILE MOUSE(6,0)=0:MX=MOUSE(0):MY=MOUSE(1):GOSUB *COL_SET:WEND
  127. 5530 GOSUB *COLDISP:GOSUB *UNDOCMD:RETURN
  128. 5600 *COL_SET
  129. 5610 GET@A (MX,MY)-(MX,MY),GC%:COLV=GC%(0):GOSUB *COLDISP2
  130. 5620 RETURN
  131. 5700 *COL_MENU
  132. 5710 PUT@A (MENX+6,367)-(MENX+151,448),CM%
  133. 5720 RETURN
  134. 6000 *CLS:GOSUB *MENUOFF
  135. 6010 MFLG=0:WHILE MFLG=0:GOSUB *PAL_SHIFT:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2):WEND:IF (MFLG AND 2)=0 THEN WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND::GET@A (0,0)-(639,479),GB%:LINE (0,0)-(1023,511),PSET,%255,BF ELSE WHILE MOUSE(6,1)=0:GOSUB *PAL_SHIFT:WEND
  136. 6020 GOSUB *MENUWRT:GOSUB *UNDOCMD:RETURN
  137. 6500 *PENSIZE:OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP
  138. 6510 PUT@ (7+MENX,368)-(150+MENX,470),PSP%,PSET,0
  139. 6520 *PS_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1)
  140. 6530 IF (MX-8) MOD 18>15 THEN *PS_LOOP
  141. 6540 IF (MY-384) MOD 18>15 THEN *PS_LOOP
  142. 6550 MX=(MX-7) \ 18:MY=(MY-384) \ 18:IF MX<0 OR MX>7 OR MY<0 OR MY>3 THEN *PS_LOOP
  143. 6560 LINE (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),XOR,7,BF:GET@ (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),PP%,%255:PS=MY*4+(MX\2)+1:DOF=PS\2:MDV=DOF+1
  144. 6570 GOSUB *COLDISP:GOSUB *UNDOCMD:PCF=0:RETURN
  145. 6600 *PENPATTERN:OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP
  146. 6610 PUT@ (7+MENX,368)-(150+MENX,470),HSP%,PSET,0
  147. 6620 *PP_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1)
  148. 6630 IF (MX-8) MOD 18>15 THEN *PP_LOOP
  149. 6640 IF (MY-384) MOD 18>15 THEN *PP_LOOP
  150. 6650 MX=(MX-7) \ 18:MY=(MY-384) \ 18:IF MX<0 OR MX>7 OR MY<0 OR MY>3 THEN *PP_LOOP
  151. 6660 LINE (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),XOR,7,BF:GET@ (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),PP%,%255:PS=16:DOF=PS\2:MDV=DOF+1
  152. 6670 GOSUB *COLDISP:GOSUB *UNDOCMD:PCF=0:RETURN
  153. 6700 *COLORPEN:OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP
  154. 6710 PUT@A (7+MENX,368)-(150+MENX,470),PSP2%
  155. 6720 *PSC_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1)
  156. 6730 IF (MX-8) MOD 18>15 THEN *PSC_LOOP
  157. 6740 IF (MY-384) MOD 18>15 THEN *PSC_LOOP
  158. 6750 MX=(MX-7) \ 18:MY=(MY-384) \ 18:IF MX<0 OR MX>7 OR MY<0 OR MY>3 THEN *PSC_LOOP
  159. 6760 GET@A (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),PPC%:LINE (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),XOR,7,BF:PS=16:DOF=PS\2:MDV=DOF+1
  160. 6770 GOSUB *COLDISP:GOSUB *UNDOCMD:PCF=1:RETURN
  161. 6800 *COLORPEN2:OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP
  162. 6810 PUT@A (7+MENX,368)-(150+MENX,470),PSP3%
  163. 6820 *PC2_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1)
  164. 6830 IF (MX-8) MOD 18>15 THEN *PC2_LOOP
  165. 6840 IF (MY-384) MOD 18>15 THEN *PC2_LOOP
  166. 6850 MX=(MX-7) \ 18:MY=(MY-384) \ 18:IF MX<0 OR MX>7 OR MY<0 OR MY>3 THEN *PC2_LOOP
  167. 6860 GET@A (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),PPC%:LINE (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),XOR,7,BF:PS=16:DOF=PS\2:MDV=DOF+1
  168. 6870 GOSUB *COLDISP:GOSUB *UNDOCMD:PCF=1:RETURN
  169. 7000 *BOX:GOSUB *UNDOGET
  170. 7010 GOSUB *BOX_WRT:IF PS<2 AND SP=0 THEN LINE (MX0,MY0)-(MX,MY),PSET,%COLV,B ELSE GOSUB *BOX_DRAW
  171. 7020 GOSUB *MENUWRT:RETURN
  172. 7050 *BOX_FILL:GOSUB *UNDOGET
  173. 7060 GOSUB *BOX_WRT:IF SP=0 THEN LINE (MX0,MY0)-(MX,MY),PSET,%COLV,BF ELSE GOSUB *SP_FILL
  174. 7070 IF PS>1 AND SP<>0 THEN GOSUB *BOX_DRAW
  175. 7080 GOSUB *MENUWRT:RETURN
  176. 7100 *BOX_WRT
  177. 7110 GOSUB *MOS_WAIT:MOUSE 1,,,0:MX0=MOUSE(0):MY0=MOUSE(1):MX=MX0:MY=MY0
  178. 7120 WHILE MOUSE(6,0)=0
  179. 7130  OMX=MX:OMY=MY:GOSUB *MXY:IF MX<>OMX OR MY<>OMY THEN LINE (MX0,MY0)-(OMX,OMY),XOR,7,B:LINE (MX0,MY0)-(MX,MY),XOR,7,B
  180. 7140 WEND
  181. 7150 LINE (MX0,MY0)-(MX,MY),XOR,7,B:RETURN
  182. 7190 *SP_FILL:A&=CALLM(OFFSET&,8):IF (A& AND 20)=4 THEN *SP_FILL_X
  183. 7200 IF (A& AND 20)=16 THEN *SP_FILL_SP ELSE IF (A& AND 20)=20 THEN *SP_FILL_SP_XOR
  184. 7210 IF MY<MY0 THEN LSTP=-1 ELSE LSTP=1
  185. 7220 FOR Y=MY0 TO MY STEP LSTP
  186. 7230  LINE (MX0,Y)-(MX,Y),PSET,%COLV:GOSUB *SP_SHIFT
  187. 7240 NEXT:RETURN
  188. 7250 *SP_FILL_X
  189. 7260 IF MX<MX0 THEN LSTP=-1 ELSE LSTP=1
  190. 7270 FOR X=MX0 TO MX STEP LSTP
  191. 7280  LINE (X,MY0)-(X,MY),PSET,%COLV:GOSUB *SP_SHIFT
  192. 7290 NEXT:RETURN
  193. 7300 *SP_FILL_SP
  194. 7310 IF MX<MX0 THEN SWAP MX,MX0
  195. 7320 FOR X=0 TO MX-MX0:LINE (MX0+X,MY0)-(MX-X,MY),PSET,%COLV:GOSUB *SP_SHIFT:NEXT
  196. 7330 IF MY<MY0 THEN SWAP MY,MY0
  197. 7340 FOR Y=0 TO MY-MY0:LINE (MX0,MY0+Y)-(MX,MY-Y),PSET,%COLV:GOSUB *SP_SHIFT:NEXT:RETURN
  198. 7350 *SP_SHIFT:COLV=COLV+1:IF COLV>255 THEN COLV=0
  199. 7360 RETURN
  200. 7400 *SP_FILL_SP_XOR
  201. 7410 IF MX<MX0 THEN SWAP MX,MX0
  202. 7420 FOR X=0 TO MX-MX0:LINE (MX0+X,MY0)-(MX-X,MY),XOR,%COLV:GOSUB *SP_SHIFT:NEXT
  203. 7430 IF MY<MY0 THEN SWAP MY,MY0
  204. 7440 FOR Y=0 TO MY-MY0:LINE (MX0,MY0+Y)-(MX,MY-Y),XOR,%COLV:GOSUB *SP_SHIFT:NEXT:RETURN
  205. 7500 *BOX_DRAW
  206. 7510 LDX1=MX0:LDY1=MY0:LDX2=MX:LDY2=MY0:GOSUB *LINE_DRAW:LDX1=MX:LDY1=MY0:LDX2=MX:LDY2=MY:GOSUB *LINE_DRAW:LDX1=MX:LDY1=MY:LDX2=MX0:LDY2=MY:GOSUB *LINE_DRAW:LDX1=MX0:LDY1=MY:LDX2=MX0:LDY2=MY0:GOSUB *LINE_DRAW:RETURN
  207. 8000 *PALFLG
  208. 8010 A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN GOSUB *PAL_INI:RETURN
  209. 8020 IF (A& AND 16)=16 THEN GOSUB *PAL_INI_ORG:RETURN
  210. 8030 FLG%=1:PALF=1-PALF:YN=PALF:GOSUB *FLGSW:RETURN
  211. 8100 *FLGSW
  212. 8110 IF YN=0 THEN PASTEL 180:LINE (MENX+BUT%(FLG%,0),BUT%(FLG%,1))-(MENX+BUT%(FLG%,2),BUT%(FLG%,3)),PASTEL,0,BF ELSE PUT@A (MENX+BUT%(FLG%,0),BUT%(FLG%,1))-(MENX+BUT%(FLG%,2),BUT%(FLG%,3)),FLG%,,,,,722*(FLG%-1)
  213. 8120 GOSUB *UNDOCMD:RETURN
  214. 8500 *SPFLG
  215. 8510 FLG%=2:SP=1-SP:YN=SP:GOSUB *FLGSW:RETURN
  216. 8600 *WREFLG
  217. 8610 FLG%=3:WREF=1-WREF:YN=WREF:GOSUB *FLGSW:RETURN
  218. 9000 *LINE_DRAW
  219. 9010 IF LDX1=LDX2 AND LDY1=LDY2 THEN X=LDX1:Y=LDY1:GOSUB *PSET:RETURN
  220. 9020 LDDX=ABS(LDX2-LDX1):LDDY=ABS(LDY2-LDY1)
  221. 9030 IF (LDX1<LDX2)=(LDY1<LDY2) THEN LSTP=1 ELSE LSTP=-1
  222. 9040 IF NOT(LDDX>LDDY) THEN *LINEDRAW2
  223. 9050 IF LDX1>LDX2 THEN *LINEDRAW3
  224. 9060  IF LDX1>LDX2 THEN LDX1=LDX2:LDY1=LDY2
  225. 9070  X=LDX1:Y=LDY1:GOSUB *PSET:S=LDDX/2
  226. 9090  FOR I=LDX1+1 TO LDX1+LDDX
  227. 9110   S=S-LDDY:IF S<0 THEN S=S+LDDX:LDY1=LDY1+LSTP
  228. 9120   IF MDV=1 OR (I MOD MDV)=1 THEN X=I:Y=LDY1:GOSUB *PSET
  229. 9130  NEXT:GOTO *LINE_DRAW_END
  230. 9140 *LINEDRAW3
  231. 9150  IF LDX1<LDX2 THEN LDX2=LDX1:LDY1=LDY2
  232. 9160  X=LDX2+LDDX:Y=LDY1:GOSUB *PSET:S=LDDX/2
  233. 9180  FOR I=LDX2+LDDX TO LDX2+1 STEP -1
  234. 9200   S=S-LDDY:IF S<0 THEN S=S+LDDX:LDY1=LDY1-LSTP
  235. 9210   IF MDV=1 OR (I MOD MDV)=1 THEN X=I:Y=LDY1:GOSUB *PSET
  236. 9220  NEXT:GOTO *LINE_DRAW_END
  237. 9230 *LINEDRAW2
  238. 9240 IF LDY1>LDY2 THEN *LINEDRAW4
  239. 9250  IF LDY1>LDY2 THEN LDY1=LDY2:LDX1=LDX2
  240. 9260  X=LDX1:Y=LDY1:GOSUB *PSET:S=LDDY/2
  241. 9280  FOR I=LDY1+1 TO LDY1+LDDY
  242. 9300   S=S-LDDX:IF S<0 THEN S=S+LDDY:LDX1=LDX1+LSTP
  243. 9310   IF MDV=1 OR (I MOD MDV)=1 THEN X=LDX1:Y=I:GOSUB *PSET
  244. 9320  NEXT:GOTO *LINE_DRAW_END
  245. 9330 *LINEDRAW4
  246. 9340  IF LDY1<LDY2 THEN LDY2=LDY1:LDX1=LDX2
  247. 9350  X=LDX1:Y=LDY2+LDDY:GOSUB *PSET:S=LDDY/2
  248. 9370  FOR I=LDY2+LDDY TO LDY2+1 STEP -1
  249. 9390   S=S-LDDX:IF S<0 THEN S=S+LDDY:LDX1=LDX1-LSTP
  250. 9400   IF MDV=1 OR (I MOD MDV)=1 THEN X=LDX1:Y=I:GOSUB *PSET
  251. 9410  NEXT:GOTO *LINE_DRAW_END
  252. 9440 *LINE_DRAW_END:RETURN
  253. 10000 *EFFECT:OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP:EFS=8
  254. 10010 PUT@ (7+MENX,368)-(150+MENX,470),EF1%,PSET,0:EFM=1
  255. 10020 *EF_LOOP:GOSUB *PMENU_MOS:IF (MFLG AND 2)<>0 THEN *EF_RET ELSE MX=MOUSE(0)-MENX:MY=MOUSE(1)
  256. 10030 IF (MX-8) MOD 36>33 THEN *EF_LOOP
  257. 10040 IF (MY-384) MOD 36>33 THEN *EF_LOOP
  258. 10050 IF MY>470 THEN *EF_LOOP ELSE MX=(MX-7) \ 36:MY=(MY-384) \ 36:IF MX<0 OR MX>3 OR MY<0 OR MY>2 THEN *EF_LOOP
  259. 10060 IF MY=2 AND (MX=1 OR MX=2) THEN *EF_LOOP ELSE IF MY<>2 THEN *EF_SEL
  260. 10070 IF MX=0 THEN EFM=EFM-1:IF EFM<1 THEN EFM=EF
  261. 10080 IF MX=3 THEN EFM=EFM+1:IF EFM>EF THEN EFM=1
  262. 10090 GOSUB *COLDISP:ON EFM GOSUB *EF1_PUT,*EF2_PUT,*EF3_PUT,*EF4_PUT:GOTO *EF_LOOP
  263. 10100 *EF1_PUT:PUT@ (7+MENX,368)-(150+MENX,470),EF1%,PSET,0:RETURN
  264. 10110 *EF2_PUT:PUT@ (7+MENX,368)-(150+MENX,470),EF2%,PSET,0:RETURN
  265. 10120 *EF3_PUT:PUT@ (7+MENX,368)-(150+MENX,470),EF3%,PSET,0:RETURN
  266. 10130 *EF4_PUT:PUT@ (7+MENX,368)-(150+MENX,470),EF4%,PSET,0:RETURN
  267. 10140 *EF_SEL:LINE (MX*36+MENX+8,MY*36+384)-(MX*36+MENX+41,MY*36+417),XOR,7,BF:EFCMD=(EFM-1)*8+MY*4+MX:IF EFCMD=15 THEN GOSUB *MENUOFF ELSE GOSUB *UNDOGET
  268. 10150 MOUSE 1,,,0:SWAP OCOLV,COLV:GOSUB *VW3
  269. 10160 ON EFCMD+1 GOSUB *COPYH,*COPYV,*MIRRORV,*MIRRORH,*SYMM4,*SYMM9,*WALL,*POSTER,*XORR,*XORC,*XORV,*XORH,*SHIFTV,*SHIFTH,*SINWAVE,*PILE,*CEBIG,*CEBIG,*CEBIG,*CEBIG,*EFFG,*EFFG,*EFFG,*EFFG,*CAMERA,*CUTOUT,*CUTSHADOW,*ZOOM,*MOSAIC,*FACET,*PMETAL,*POST
  270. 10170 GOSUB *MENUWRT
  271. 10180 *EF_RET:GOSUB *VW0:MOUSE 1,,,1:GOSUB *COLDISP:GOSUB *UNDOCMD:RETURN
  272. 10500 *PMENU_MOS
  273. 10510 MFLG=0:WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2):WEND:IF (MFLG AND 2)=0 THEN WHILE MOUSE(6,0)=0:WEND ELSE WHILE MOUSE(6,1)=0:WEND
  274. 10520 RETURN
  275. 11000 *SHIFTV
  276. 11010 FOR X=0 TO (320/EFS)-1 
  277. 11020  GET@A (X*EFS*2,480-EFS)-(X*EFS*2+EFS-1,479),WG%,19200:GET@A (X*EFS*2,0)-(X*EFS*2+EFS-1,479-EFS),WG%:PUT@A (X*EFS*2,0)-(X*EFS*2+EFS-1,EFS-1),WG%,,,,,19200:PUT@A (X*EFS*2,EFS)-(X*EFS*2+EFS-1,479),WG%
  278. 11030  GET@A (X*EFS*2+EFS,0)-(X*EFS*2+EFS*2-1,EFS-1),WG%,19200:GET@A (X*EFS*2+EFS,EFS)-(X*EFS*2+EFS*2-1,479),WG%:PUT@A (X*EFS*2+EFS,480-EFS)-(X*EFS*2+EFS*2-1,479),WG%,,,,,19200:PUT@A (X*EFS*2+EFS,0)-(X*EFS*2+EFS*2-1,479-EFS),WG%
  279. 11040 NEXT:RETURN
  280. 11050 *SHIFTH
  281. 11060 FOR Y=0 TO (240/EFS)-1 
  282. 11070  GET@A (640-EFS,Y*EFS*2)-(639,Y*EFS*2+EFS-1),WG%,19200:GET@A (0,Y*EFS*2)-(639-EFS,Y*EFS*2+EFS-1),WG%:PUT@A (0,Y*EFS*2)-(EFS-1,Y*EFS*2+EFS-1),WG%,,,,,19200:PUT@A (EFS,Y*EFS*2)-(639,Y*EFS*2+EFS-1),WG%
  283. 11080  GET@A (0,Y*EFS*2+EFS)-(EFS-1,Y*EFS*2+EFS*2-1),WG%,19200:GET@A (EFS,Y*EFS*2+EFS)-(639,Y*EFS*2+EFS*2-1),WG%:PUT@A (640-EFS,Y*EFS*2+EFS)-(639,Y*EFS*2+EFS*2-1),WG%,,,,,19200:PUT@A (0,Y*EFS*2+EFS)-(639-EFS,Y*EFS*2+EFS*2-1),WG%
  284. 11090 NEXT:RETURN
  285. 11100 *MIRRORV
  286. 11110 FOR X=0 TO 319
  287. 11120  GET@A (X,0)-(X,479),WG%,19200:GET@A (639-X,0)-(639-X,479),WG%:PUT@A (X,0)-(X,479),WG%:PUT@A (639-X,0)-(639-X,479),WG%,,,,,19200
  288. 11130 NEXT:RETURN
  289. 11150 *MIRRORH
  290. 11160 FOR Y=0 TO 239
  291. 11170  GET@A (0,Y)-(639,Y),WG%,19200:GET@A (0,479-Y)-(639,479-Y),WG%:PUT@A (0,Y)-(639,Y),WG%:PUT@A (0,479-Y)-(639,479-Y),WG%,,,,,19200
  292. 11180 NEXT:RETURN
  293. 11200 *MOS_BOX:MX=MOUSE(6,0)
  294. 11210 IF MX0=640 AND MY0=480 THEN MX=0:MY=0:RETURN
  295. 11220 IF MX0=640 THEN MOUSE 4,0,0,0,(479-MY0):MOUSE 1,0,(MY0\2),0:GOTO *SKP_SET
  296. 11230 IF MY0=480 THEN MOUSE 4,0,0,(639-MX0),0:MOUSE 1,(MX0\2),0,0:GOTO *SKP_SET
  297. 11240 MOUSE 4,0,0,(639-MX0),(479-MY0):MOUSE 1,(MX0\2),(MY0\2),0
  298. 11250 *SKP_SET:MX=MOUSE(0):MY=MOUSE(1):LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,7,B:MFLG=0
  299. 11260 WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2)
  300. 11270  OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF OMX<>MX OR OMY<>MY THEN LINE (OMX,OMY)-(OMX+MX0-1,OMY+MY0-1),XOR,7,B:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,7,B
  301. 11280 WEND:IF (MFLG AND 1)=1 THEN WHILE MOUSE(6,0)=0:WEND:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,7,B:MOUSE 4,0,0,639,479:RETURN
  302. 11290 WHILE MOUSE(6,1)=0:WEND:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,7,B:MOUSE 4,0,0,639,479:RETURN *MOSBRET
  303. 11300 *MOSBRET:RETURN
  304. 11500 *SYMM4
  305. 11510 MX0=320:MY0=240:GOSUB *MOS_BOX:GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),WG%:PUT@A (0,0)-(MX0-1,MY0-1),WG%
  306. 11520 FOR X=0 TO 319:GET@A (X,0)-(X,239),WG%:PUT@A (639-X,0)-(639-X,239),WG%:NEXT
  307. 11530 FOR Y=0 TO 239:GET@A (0,Y)-(639,Y),WG%:PUT@A (0,479-Y)-(639,479-Y),WG%:NEXT:RETURN
  308. 11600 *SYMM9
  309. 11610 MX0=214:MY0=160:GOSUB *MOS_BOX:GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),WG%:PUT@A (0,0)-(MX0-1,MY0-1),WG%
  310. 11620 FOR X=0 TO 213:GET@A (X,0)-(X,159),WG%:PUT@A (427-X,0)-(427-X,159),WG%:NEXT:GET@A (0,0)-(211,159),WG%:PUT@A (428,0)-(639,159),WG%
  311. 11630 FOR Y=0 TO 159:GET@A (0,Y)-(639,Y),WG%:PUT@A (0,319-Y)-(639,319-Y),WG%:NEXT:GET@A (0,0)-(639,79),WG%:PUT@A (0,320)-(639,399),WG%:GET@A (0,80)-(639,159),WG%:PUT@A (0,400)-(639,479),WG%:RETURN
  312. 11700 *WALL
  313. 11710 GSV=2:GS=5:GS!(0)=4:GS!(1)=9:GS!(2)=16:GS!(3)=25:GS!(4)=36:GS!(5)=49:M$=" ＜分割数を設定＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5
  314. 11720 GOSUB *MOS_BOX:GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),WG%
  315. 11730 FOR X=0 TO SQR(GS!(GSV))-1:FOR Y=0 TO SQR(GS!(GSV))-1:PUT@A (X*MX0,Y*MY0)-(X*MX0+MX0-1,Y*MY0+MY0-1),WG%:NEXT:NEXT:RETURN
  316. 11740 *WAL0:MX0=320:MY0=240:RETURN
  317. 11750 *WAL1:MX0=214:MY0=160:RETURN
  318. 11760 *WAL2:MX0=160:MY0=120:RETURN
  319. 11770 *WAL3:MX0=128:MY0=96:RETURN
  320. 11780 *WAL4:MX0=107:MY0=80:RETURN
  321. 11790 *WAL5:MX0=92:MY0=69:RETURN
  322. 11800 *GETSIZE
  323. 11810 GOSUB *MENUWRT:MOUSE 1,,,1:LINE (7+MENX,384)-(150+MENX,455),PSET,0,BF,7:SYMBOL (MENX+45,456),"Set(決定)",.9!,1,0:LINE (MENX+43,455)-(MENX+113,471),PSET,0,B:SYMBOL (MENX+8,436),M$,1,1,0:GOTO *GS_PUT
  324. 11820 *GS_LOOP:MFLG=0:WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2):WEND:IF (MFLG AND 2)=2 THEN WHILE MOUSE(6,1)=0:WEND:RETURN *BASERET
  325. 11830 WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0):MY=MOUSE(1):IF MX<MENX+7 OR MX>MENX+150 OR MY<455 OR MY>470 THEN *GS_LOOP
  326. 11840 MX=MX-MENX:IF MX<43 THEN GSV=GSV-1:IF GSV<0 THEN GSV=GS
  327. 11850 IF MX>113 THEN GSV=GSV+1:IF GSV>GS THEN GSV=0
  328. 11860 IF MX>42 AND MX<114 THEN *GS_LOOP_OUT
  329. 11870 *GS_PUT:LINE (MENX+26,386)-(MENX+131,434),PSET,0,BF,7:IF LEN(STR$(GS!(GSV)))>4 THEN SYMBOL (MENX+37,388),RIGHT$("    "+STR$(GS!(GSV)),4),2,3,0,,,3:GOTO *GS_LOOP ELSE SYMBOL (MENX+37,388),RIGHT$("   "+STR$(GS!(GSV)),3),3,3,0,,,3:GOTO *GS_LOOP 
  330. 11880 *GS_LOOP_OUT:MOUSE 1,,,0:GOSUB *UNDOGET:RETURN
  331. 11890 *BASERET:MOUSE 1,,,0:GOSUB *MENUOFF:RETURN
  332. 12000 *SINWAVE
  333. 12010 GSV=9:GS=32:FOR A=1 TO 33:GS!(A-1)=A*5:NEXT:M$=" ＜ 波の大きさ ＞":GOSUB *GETSIZE:MY0=GS!(GSV):MX0=1
  334. 12020 FOR X=0 TO 639 STEP MX0:Y=SIN(3.14!*X/180)*MY0+MY0
  335. 12030  GET@A (X,480-Y)-(X+MX0-1,479),WG%,19200:GET@A (X,0)-(X+MX0-1,479-Y),WG%:PUT@A (X,0)-(X+MX0-1,Y-1),WG%,,,,,19200:PUT@A (X,Y)-(X+MX0-1,479),WG%
  336. 12040 NEXT:RETURN
  337. 12100 *XORR
  338. 12110 GOSUB *OBI:IF (MFLG AND 2)=2 THEN RETURN ELSE MY0=GS!(GSV):GOSUB *VW3
  339. 12120 FOR Y=479 TO 240+MY0 STEP -MY0
  340. 12130  LINE (479-Y,479-Y)-(Y+160,Y),XOR,%COLV,BF:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=1
  341. 12140 NEXT:RETURN
  342. 12190 *OBI:GSV=9:GS=32:FOR A=1 TO 33:GS!(A-1)=A:NEXT:M$=" ＜   帯の幅   ＞":GOSUB *GETSIZE:RETURN
  343. 12200 *XORC
  344. 12210 GOSUB *OBI:IF (MFLG AND 2)=2 THEN RETURN ELSE MX0=GS!(GSV):GOSUB *VW3
  345. 12220 FOR X=MX0 TO 420 STEP MX0
  346. 12230  CIRCLE (320,240),X,%COLV,,,,F,XOR:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=1
  347. 12240 NEXT:RETURN
  348. 12300 *XORV
  349. 12310 GOSUB *OBI:IF (MFLG AND 2)=2 THEN RETURN ELSE MX0=GS!(GSV):GOSUB *VW3
  350. 12320 FOR X=0 TO 639 STEP MX0*2
  351. 12330  LINE (X,0)-(X+MX0-1,479),XOR,%COLV,BF:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=1
  352. 12340 NEXT:RETURN
  353. 12400 *XORH
  354. 12410 GOSUB *OBI:IF (MFLG AND 2)=2 THEN RETURN ELSE MY0=GS!(GSV):GOSUB *VW3
  355. 12420 FOR Y=0 TO 479 STEP MY0*2
  356. 12430  LINE (0,Y)-(639,Y+MY0-1),XOR,%COLV,BF:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=1
  357. 12440 NEXT:RETURN
  358. 12450 *CEBIG:EFCMD=EFCMD-16:GSV=1:GS=1:GS!(0)=1:GS!(1)=4:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:IF GSV=0 THEN MM=28:MX0=640:MY0=480 ELSE MM=20:MX0=320:MY0=240
  359. 12460 ON EFCMD+1 GOSUB *CENTERBIGV,*CENTERBIGH,*EDGEBIGV,*EDGEBIGH
  360. 12470 *SETCBIG:GS!(0)=0:GS!(1)=1:GS!(2)=2:GS!(3)=3:GS!(4)=4:GS!(5)=4:GS!(6)=5:GS!(7)=5:GS!(8)=5:GS!(9)=6:GS!(10)=6:GS!(11)=6:GS!(12)=7:GS!(13)=7:GS!(14)=7:GS!(15)=7:GS!(16)=8:GS!(17)=8:GS!(18)=8:GS!(19)=9:GS!(20)=9:GS!(21)=9:GS!(22)=10
  361. 12475 GS!(23)=10:GS!(24)=10:GS!(25)=11:GS!(26)=11:GS!(27)=11:GS!(28)=11:RETURN
  362. 12480 *SETEBIG:GS!(28)=0:GS!(27)=0:GS!(26)=0:GS!(25)=0:GS!(24)=0:GS!(23)=0:GS!(22)=0:GS!(21)=0
  363. 12485 GS!(20)=0:GS!(19)=0:GS!(18)=0:GS!(17)=0:GS!(16)=1:GS!(15)=1:GS!(14)=2:GS!(13)=2:GS!(12)=3:GS!(11)=3:GS!(10)=4:GS!(9)=4:GS!(8)=4:GS!(7)=5:GS!(6)=5:GS!(5)=6:GS!(4)=7:GS!(3)=8:GS!(2)=9:GS!(1)=10:GS!(0)=11:RETURN
  364. 12490 *SETEBIG2:GOSUB *SETEBIG:FOR A=0 TO MM-5:GS!(A)=GS!(A+5):NEXT:RETURN
  365. 12500 *CENTERBIGV:GOSUB *SETCBIG:GOTO *BIGV
  366. 12510 *EDGEBIGV:GOSUB *SETEBIG:GOTO *BIGV 
  367. 12520 *BIGV:GOSUB *MOS_BOX:X=(MX0\2)-1:MX0=MX+MX0-1:MY0=MY+MY0-1:A=MM:LDY=MY:YL0=MY0
  368. 12530 WHILE X>-1:MM=GS!(A):IF INKEY$=CHR$(27) THEN X=0:GOTO *BVLOP
  369. 12540  IF MX+X-MM<MX THEN MM0=X ELSE MM0=MM
  370. 12550   LDX=MX+MM0:XL0=MX+X:GOSUB *GETBIGY:LDX=MX:XL0=MX+X-MM0:GOSUB *PUTBIGY
  371. 12560  IF MX0-X+MM>MX0 THEN MM0=X ELSE MM0=MM
  372. 12570   LDX=MX0-MM0:XL0=MX0-X:GOSUB *GETBIGY:LDX=MX0-X+MM0:XL0=MX0:GOSUB *PUTBIGY
  373. 12580  WHILE MM>0
  374. 12590   IF MX+X-1=>MX THEN GET@A (MX+X,MY)-(MX+X,MY0),WG%:PUT@A (MX+X-1,MY)-(MX+X-1,MY0),WG%
  375. 12600   IF MX0+1-X<=MX0 THEN GET@A (MX0-X,MY)-(MX0-X,MY0),WG%:PUT@A (MX0+1-X,MY)-(MX0+1-X,MY0),WG%
  376. 12610  X=X-1:MM=MM-1:WEND:X=X-1:A=A-1:IF A<0 THEN A=0
  377. 12620 *BVLOP:WEND:RETURN
  378. 12700 *CENTERBIGH:GOSUB *SETCBIG:GOTO *BIGH
  379. 12710 *EDGEBIGH:GOSUB *SETEBIG2:GOTO *BIGH
  380. 12720 *BIGH:GOSUB *MOS_BOX:Y=(MY0\2)-1:MX0=MX+MX0-1:MY0=MY+MY0-1:A=MM:LDX=MX:XL0=MX0
  381. 12730 WHILE Y>-1:MM=GS!(A):IF INKEY$=CHR$(27) THEN Y=0:GOTO *BHLOP
  382. 12740  IF MY+Y-MM<MY THEN MM0=Y ELSE MM0=MM
  383. 12750   LDY=MY+MM0:YL0=MY+Y:GOSUB *GETBIGX:LDY=MY:YL0=MY+Y-MM0:GOSUB *PUTBIGX
  384. 12760  IF MY0-Y+MM>MY0 THEN MM0=Y ELSE MM0=MM
  385. 12770   LDY=MY0-MM0:YL0=MY0-Y:GOSUB *GETBIGX:LDY=MY0-Y+MM0:YL0=MY0:GOSUB *PUTBIGX
  386. 12780  WHILE MM>0
  387. 12790   IF MY+Y-1=>MY THEN GET@A (MX,MY+Y)-(MX0,MY+Y),WG%:PUT@A (MX,MY+Y-1)-(MX0,MY+Y-1),WG%
  388. 12800   IF MY0+1-Y<=MY0 THEN GET@A (MX,MY0-Y)-(MX0,MY0-Y),WG%:PUT@A (MX,MY0+1-Y)-(MX0,MY0+1-Y),WG%
  389. 12810  Y=Y-1:MM=MM-1:WEND:Y=Y-1:A=A-1:IF A<0 THEN A=0
  390. 12820 *BHLOP:WEND:RETURN
  391. 12830 *GETBIGX:XX=(XL0-LDX)/2:GET@A (LDX,LDY)-(LDX+XX-1,YL0),WG%:GET@A (LDX+XX,LDY)-(XL0,YL0),MGB%:RETURN
  392. 12840 *GETBIGY:YY=(YL0-LDY)/2:GET@A (LDX,LDY)-(XL0,LDY+YY-1),WG%:GET@A (LDX,LDY+YY)-(XL0,YL0),MGB%:RETURN
  393. 12850 *PUTBIGX:XX=(XL0-LDX)/2:PUT@A (LDX,LDY)-(LDX+XX-1,YL0),WG%:PUT@A (LDX+XX,LDY)-(XL0,YL0),MGB%:RETURN
  394. 12860 *PUTBIGY:YY=(YL0-LDY)/2:PUT@A (LDX,LDY)-(XL0,LDY+YY-1),WG%:PUT@A (LDX,LDY+YY)-(XL0,YL0),MGB%:RETURN
  395. 12900 *POSTER
  396. 12910 GSV=2:GS=5:GS!(0)=4:GS!(1)=9:GS!(2)=16:GS!(3)=25:GS!(4)=36:GS!(5)=49:M$=" ＜分割数を設定＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5
  397. 12920 GOSUB *MOS_BOX:GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),WG%
  398. 12930 FOR X=0 TO SQR(GS!(GSV))-1:FOR Y=0 TO SQR(GS!(GSV))-1:PUT@A (X*MX0,Y*MY0)-(X*MX0+MX0-1,Y*MY0+MY0-1),WG%:LINE (X*MX0,Y*MY0)-(X*MX0+MX0-1,Y*MY0+MY0-1),PSET,0,B:NEXT:NEXT
  399. 12940 X=(640-MX0)\2:Y=(480-MY0)\2:PASTEL 128:LINE (X+8,Y+8)-(X+MX0+7,Y+MY0+7),PASTEL,0,BF:PUT@A (X-4,Y-4)-(X+MX0-5,Y+MY0-5),WG%:LINE (X-4,Y-4)-(X+MX0-5,Y+MY0-5),PSET,0,B:RETURN
  400. 14000 *COPYV
  401. 14010 FOR X=0 TO 319
  402. 14020  GET@A (X,0)-(X,479),WG%:PUT@A (639-X,0)-(639-X,479),WG%
  403. 14030 NEXT:RETURN
  404. 14050 *COPYH
  405. 14060 FOR Y=0 TO 239
  406. 14070  GET@A (0,Y)-(639,Y),WG%:PUT@A (0,479-Y)-(639,479-Y),WG%
  407. 14080 NEXT:RETURN
  408. 14100 *POST
  409. 14110 GSV=1:GS=5:GS!(0)=1:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *EFF0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5
  410. 14120 EFFGF=0:GOSUB *MOS_BOX:A&=CALLM(OFFSET&,8):X=-9253
  411. 14130  IF (A& AND 4)=4 THEN X=-28014
  412. 14140  IF (A& AND 16)=16 THEN X=-18762
  413. 14150  IF (A& AND 20)=20 THEN X=28013
  414. 14160 IF GSV=0 THEN *POST_FULL
  415. 14170 GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),WG%:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),PSET,7,BF
  416. 14180 GOSUB *POSTSET
  417. 14190 PUT@A (MX,MY)-(MX+MX0-1,MY+MY0-1),WG%:GOTO *POSTRET
  418. 14200 *POST_FULL
  419. 14210 FOR Y=0 TO 3:GOSUB *POSTRET:GET@A (0,Y*120)-(639,Y*120+119),WG%:LINE (0,Y*120)-(639,Y*120+119),PSET,7,BF:GOSUB *POSTSET:PUT@A (0,Y*120)-(639,Y*120+119),WG%:NEXT
  420. 14230 *POSTRET
  421. 14240 OUT &H458,0:OUT &H45A,-1,2:OUT &H458,1:OUT &H45A,-1,2:RETURN
  422. 14250 *POSTSET:OUT &H458,0:OUT &H45A,X,2:OUT &H458,1:OUT &H45A,X,2:RETURN
  423. 15000 *EFFG
  424. 15010 GSV=2:GS=5:GS!(0)=1:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *EFF0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5
  425. 15020 EFFGF=0:GOSUB *MOS_BOX:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,6,B:LDX=MX:LDY=MY:XL0=LDX+MX0-1:YL0=LDY+MY0-1:A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 OR GSV=0 THEN EFFGF=1
  426. 15030 GOSUB *EFF0_MOS
  427. 15040 LINE (LDX,LDY)-(XL0,YL0),XOR,6,B:IF GSV=0 THEN GET@A (0,0)-(639,479),GB% ELSE GET@A (LDX,LDY)-(XL0,YL0),WG%
  428. 15050 IF EFFGF=1 THEN VIEW (LDX,LDY)-(XL0,YL0):WINDOW (LDX,LDY)-(XL0,YL0) ELSE GOSUB *VW3
  429. 15060 MX0=MAP(MX+MX0-1,0):MY0=MAP(MY+MY0-1,1):MX=MAP(MX,0):MY=MAP(MY,1):ON EFCMD-19 GOSUB *PASTELG,*XORG,*ANDG,*ORG:GOSUB *VW3:RETURN
  430. 15100 *EFF0:MX0=640:MY0=480:RETURN
  431. 15200 *EFF0_MOS
  432. 15210 MOUSE 1,320,240,0:MX=MOUSE(6,0)
  433. 15220 MX=MOUSE(0):MY=MOUSE(1):LINE (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),XOR,7,B
  434. 15230 WHILE MOUSE(2,0)=0
  435. 15240  OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF OMX<>MX OR OMY<>MY THEN LINE (OMX-(MX0\2),OMY-(MY0\2))-(OMX+(MX0\2)-1,OMY+(MY0\2)-1),XOR,7,B:LINE (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),XOR,7,B
  436. 15250 WEND:WHILE MOUSE(6,0)=0:WEND:LINE (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),XOR,7,B:MX=MX-(MX0\2):MY=MY-(MY0\2):RETURN
  437. 15300 *PASTELG
  438. 15310 PASTEL 128:IF GSV=0 THEN PUT@A (MX,MY)-(MX0,MY0),GB%,PASTEL:RETURN ELSE PUT@A (MX,MY)-(MX0,MY0),WG%,PASTEL:RETURN
  439. 15350 *XORG
  440. 15360 IF GSV=0 THEN PUT@A (MX,MY)-(MX0,MY0),GB%,XOR:RETURN ELSE PUT@A (MX,MY)-(MX0,MY0),WG%,XOR:RETURN
  441. 15400 *ANDG
  442. 15410 IF GSV=0 THEN PUT@A (MX,MY)-(MX0,MY0),GB%,AND:RETURN ELSE PUT@A (MX,MY)-(MX0,MY0),WG%,AND:RETURN
  443. 15450 *ORG
  444. 15460 IF GSV=0 THEN PUT@A (MX,MY)-(MX0,MY0),GB%,OR:RETURN ELSE PUT@A (MX,MY)-(MX0,MY0),WG%,OR:RETURN
  445. 15500 *MOS_PAT:MX=MOUSE(6,0):GOSUB *VW3
  446. 15510 IF MX0=640 AND MY0=480 THEN MX=0:MY=0:RETURN
  447. 15520 MOUSE 4,0,0,639,479:MOUSE 1,(MX0\2),(MY0\2),0
  448. 15530 MX=MOUSE(0):MY=MOUSE(1):PUT@ (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),CUTP%,XOR,7:MFLG=0
  449. 15540 WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2)
  450. 15550  OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF OMX<>MX OR OMY<>MY THEN PUT@ (OMX-(MX0\2),OMY-(MY0\2))-(OMX+(MX0\2)-1,OMY+(MY0\2)-1),CUTP%,XOR,7:PUT@ (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),CUTP%,XOR,7
  451. 15560 WEND:IF (MFLG AND 1)=1 THEN WHILE MOUSE(6,0)=0:WEND ELSE WHILE MOUSE(6,1)=0:WEND
  452. 15570 PUT@ (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),CUTP%,XOR,7:MOUSE 4,0,0,639,479:MX=MX-(MX0\2):MY=MY-(MY0\2):RETURN
  453. 15590 *CAM0:MX0=640:MY0=240:RETURN
  454. 16000 *CAMERA
  455. 16010 GSV=1:GS=5:GS!(0)=2:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *CAM0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5
  456. 16020 GOSUB *MOS_BOX:CUTX=MX0:CUTY=MY0:CUTV=GSV
  457. 16050 GET@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,%COLV:RETURN
  458. 16100 *CUTOUT:A&=CALLM(OFFSET&,8):IF (A& AND 16)=16 THEN *CUT7 ELSE *CUT0
  459. 16110 *CUT7:MX0=CUTX:MY0=CUTY:GOSUB *MOS_PAT:IF (MFLG AND 2)=2 THEN RETURN
  460. 16120 A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN *CUTIN
  461. 16130 GET@A (0,0)-(639,479),GB%:LINE (0,0)-(639,479),PSET,7,BF:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,PSET,0:PUT@A (0,0)-(639,479),GB%,OR:RETURN
  462. 16140 *CUTIN:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0),CUTP%,PSET,7:RETURN
  463. 16150 *CUT0
  464. 16160 MX0=CUTX:MY0=CUTY:GOSUB *MOS_PAT:IF (MFLG AND 2)=2 THEN RETURN
  465. 16170 A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN *CUT0IN
  466. 16180 GET@A (0,0)-(639,479),GB%:LINE (0,0)-(639,479),PSET,0,BF:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,PSET,7:PUT@A (0,0)-(639,479),GB%,AND:RETURN
  467. 16190 *CUT0IN:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0),CUTP%,PSET,0:RETURN
  468. 16300 *CUTSHADOW
  469. 16310 MX0=CUTX:MY0=CUTY:GOSUB *MOS_PAT:IF (MFLG AND 2)=2 THEN RETURN ELSE PUT@ (MX,MY)-(MX+MX0-1,MY+MY0),CUTP%,XOR,6:LDX=MX:LDY=MY:GOSUB *MOS_PAT:PUT@ (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),CUTP%,XOR,6:IF (MFLG AND 2)=2 THEN RETURN
  470. 16330 GET@A (0,0)-(639,479),GB%:LINE (0,0)-(639,479),PSET,0,BF:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,PSET,7:PUT@A (0,0)-(639,479),GB%,AND:GOSUB *VW2:LINE (0,480)-(639,511),PSET,0,BF
  471. 16340 IF CUTV<>0 THEN GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),WG%:LINE (0,0)-(639,479),PSET,0,BF:PUT@A (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),WG%:GOTO *SKP_SHADOW
  472. 16350 GET@A (MX,MY)-(MX+319,MY+MY0-1),WG%:GET@A (MX+320,MY)-(MX+631,MY+MY0-1),MGB%:LINE (0,0)-(639,479),PSET,0,BF:PUT@A (LDX,LDY)-(LDX+319,LDY+MY0-1),WG%:PUT@A (LDX+320,LDY)-(LDX+631,LDY+MY0-1),MGB%
  473. 16360 *SKP_SHADOW:GET@A (0,LDY)-(319,LDY+MY0-1),WG%:GET@A (320,LDY)-(639,LDY+MY0-1),MGB%:PUT@A (0,0)-(639,479),GB%:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,PSET,0:PUT@ (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),CUTP%,PSET,0
  474. 16370 PUT@A (0,LDY)-(319,LDY+MY0-1),WG%,MATTE,,,0:PUT@A (320,LDY)-(639,LDY+MY0-1),MGB%,MATTE,,,0:A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN PASTEL 128:PUT@ (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),CUTP%,PASTEL,7
  475. 16380 IF (A& AND 16)=16 THEN PASTEL 128:PUT@ (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),CUTP%,PASTEL,0
  476. 16390 RETURN
  477. 16400 *EXCHG_BUF:GOSUB *VW0:GOSUB *EXCHG_BUFFER:GOSUB *VW3:RETURN
  478. 16410 *EXCHG_MATTE
  479. 16420 FOR A=0 TO 14:GET@A (0,A*32)-(639,A*32+31),WG%:PUT@A (0,480)-(639,511),WG%:PUT@A (0,A*32)-(639,A*32+31),GB%,PSET,,,,A*10240:GET@A (0,480)-(639,511),GB%,A*10240:NEXT:RETURN
  480. 16500 *ZOOM
  481. 16510 GSV=3:GS=6:GS!(0)=.125!:GS!(1)=.25!:GS!(2)=.5!:GS!(3)=2:GS!(4)=3:GS!(5)=4:GS!(6)=7:M$=" ＜ＺＯＯＭ倍率＞":GOSUB *GETSIZE:IF GS!(GSV)<1 THEN MX0=640:MY0=480 ELSE ON GSV-1 GOSUB *WAL0,*WAL1,*WAL2,*WAL3
  482. 16520 GOSUB *MOS_BOX:WFCMD=1:A&=CALLM(OFFSET&,8)
  483. 16530 IF GS!(GSV)<1 THEN *ZOOMOUT
  484. 16540 GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),WG%:IF (A& AND 16)<>16 THEN LINE (0,0)-(639,479),PSET,0,BF
  485. 16550 A=GS!(GSV):WFV=(640-MX0)\15:GSV=WFV*.75!:LDX=WFV*14:LDY=480-MY0:A!=(LDY-GSV)/TAN(3.14!*14*6/180):B!=(SQR(A)-1)/15:PUT@A (640-MX0,480-MY0-GSV)-(639,479-GSV),WG%
  486. 16560 FOR I=0 TO 14
  487. 16570  IF (A& AND 4)=4 AND (I AND 1)=1 THEN PASTEL 1:LINE (0,0)-(639,479),PASTEL,0,BF
  488. 16580  X=LDX-I*WFV:Y=FIX(TAN(3.14!*I*6/180)*-A!)+LDY-GSV
  489. 16590  PUT@A (X,Y)-(X+MX0-1,Y+MY0-1),WG%,PSET,B!*(I+1)+1,B!*(I+1)+1
  490. 16600  IF INKEY$=CHR$(27) THEN I=100
  491. 16610 NEXT:RETURN
  492. 16620 *ZOOMOUT:Y=0:A!=1:B!=(1-SQR(GS!(GSV)))/(10*(3-GSV))
  493. 16630 FOR X=0 TO 240-GSV*80 STEP 8:Y=Y+6
  494. 16640  IF (A& AND 4)=4 THEN PASTEL 1:LINE (0,0)-(639,479),PASTEL,0,BF
  495. 16650  PUT@A (X,Y)-(X+639,Y+479),GB%,PSET,A!,A!:A!=A!-B!
  496. 16660  IF INKEY$=CHR$(27) THEN X=1000
  497. 16670 NEXT:RETURN
  498. 17000 *CAMGET:COLOR ,,7:GOSUB *VW1
  499. 17100 CLS:PRINT "AmazingPAINT is Painting Tool for Hobby Painters"
  500. 17110 PRINT "    This Program Running on..."
  501. 17120 LOAD@ ".\CAMERA0.TIF",(0,120):WAIT 100
  502. 17130 CUTX=640:CUTY=240:CUTV=0:GET@ (0,60)-(639,299),CUTP%,7:RETURN
  503. 17500 *FACET
  504. 17510 WFV=1:WFCMD=1:GSV=2:GS=5:GS!(0)=1:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *EFF0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5
  505. 17520 GSV=1:GS=3:GS!(0)=1:GS!(1)=2:GS!(2)=3:GS!(3)=4:M$=" ＜画素の大きさ＞":GOSUB *GETSIZE:WFV=GSV+1
  506. 17530 GOSUB *MOS_BOX:A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN IF (A& AND 16)=16 THEN WFCMD=3:CP=WFV*4*WFV-1 ELSE WFCMD=2
  507. 17540 LDX=MX:LDY=MY:GOSUB *FACET_WRT:RETURN
  508. 17600 *MOSAIC
  509. 17610 WFV=1:WFCMD=1:GSV=2:GS=5:GS!(0)=1:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *EFF0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5
  510. 17620 GSV=6:GS=14:FOR A=0 TO 14:GS!(A)=A+2:NEXT:M$=" ＜画素の大きさ＞":GOSUB *GETSIZE:WFV=GSV+2
  511. 17630 GOSUB *MOS_BOX:A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN IF (A& AND 16)=16 THEN WFCMD=3:CP=WFV*WFV\4-1 ELSE WFCMD=2
  512. 17640 LDX=MX:LDY=MY:GOSUB *MOSAIC_WRT:RETURN
  513. 17800 *FACET_WRT:GOSUB *VW0
  514. 17810 FOR Y=LDY TO LDY+MY0-1 STEP 32*WFV
  515. 17820  FOR X=LDX TO LDX+MX0-1 STEP 32*WFV
  516. 17830  GOSUB *VW1:GET@A (X,Y)-(X+32*WFV-1,Y+32*WFV-1),WFP%:PUT@A (640,0)-(32*WFV+639,32*WFV-1),WFP%
  517. 17840   FOR YY=0 TO 7:FOR XX=0 TO 7
  518. 17850    GOSUB *VW1:GET@A (640+XX*4*WFV,YY*4*WFV)-(640+(XX+1)*4*WFV-1,(YY+1)*4*WFV-1),CP&
  519. 17860    GOSUB *WFCMD:A&=FRE(1):IF INKEY$=CHR$(27) THEN YY=7:XX=7:X=1000:Y=1000:GOTO *FACET_BREAK
  520. 17870    VIEW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):WINDOW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):DEF PEN 0,0:GOSUB *WRITEFACET
  521. 17880   *FACET_BREAK:NEXT:NEXT
  522. 17890  NEXT
  523. 17900 NEXT
  524. 17910 GOSUB *VW0:DEF PEN 0,1:RETURN
  525. 18000 *MOSAIC_WRT:GOSUB *VW0:VIEW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):WINDOW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):DEF PEN 0,0:LINE (X,Y)-(X+WFV-1,Y+WFV-1),PSET,0,BF
  526. 18010 FOR Y=LDY TO LDY+MY0-1 STEP WFV
  527. 18020  FOR X=LDX TO LDX+MX0-1 STEP WFV
  528. 18030   GOSUB *VW0:DEF PEN 0,1
  529. 18040   GET@A (X,Y)-(X+WFV-1,Y+WFV-1),CP&
  530. 18050    GOSUB *WFMCMD:A&=FRE(1):IF INKEY$=CHR$(27) THEN X=1000:Y=1000:GOTO *MOSAIC_BREAK
  531. 18060    VIEW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):WINDOW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1)
  532. 18070    DEF PEN 0,0:LINE (X,Y)-(X+WFV-1,Y+WFV-1),PSET,0,BF,PP$
  533. 18080   *MOSAIC_BREAK
  534. 18090  NEXT
  535. 18100 NEXT
  536. 18110 GOSUB *VW0:DEF PEN 0,1:RETURN
  537. 18160 *WRITEFACET:XXX=XX*4:YYY=YY*4
  538. 18170 ON XX+1 GOSUB *WFX0,*WFX1,*WFX2,*WFX3,*WFX4,*WFX5,*WFX6,*WFX7
  539. 18180 RETURN
  540. 18190 *WFX0:ON YY+1 GOTO *WFY00,*WFY01,*WFY02,*WFY03,*WFY04,*WFY05,*WFY06,*WFY07
  541. 18200 *WFY00:CONNECT (X+(XXX-1)*WFV,Y+(YYY+2)*WFV)-STEP(2*WFV,-3*WFV)-STEP(3*WFV,0)-STEP(0,5*WFV)-STEP(-5*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  542. 18210 *WFY01:CONNECT (X+(XXX-1)*WFV,Y+(YYY-2)*WFV)-STEP(5*WFV,2*WFV)-STEP(-1*WFV,4*WFV)-STEP(-3*WFV,0)-STEP(-1*WFV,-6*WFV),0,PSET,F,PP$:RETURN
  543. 18220 *WFY02:CONNECT (X+(XXX-1)*WFV,Y+(YYY+1)*WFV)-STEP(1*WFV,-1*WFV)-STEP(3*WFV,0)-STEP(-1*WFV,4*WFV)-STEP(-2*WFV,0)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  544. 18230 *WFY03:CONNECT (X+(XXX-1)*WFV,Y+(YYY+4)*WFV)-STEP(1*WFV,-4*WFV)-STEP(5*WFV,0)-STEP(-2*WFV,3*WFV)-STEP(-4*WFV,1*WFV),0,PSET,F,PP$:RETURN
  545. 18240 *WFY04:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(1*WFV,4*WFV)-STEP(-4*WFV,1*WFV)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  546. 18250 *WFY05:CONNECT (X+(XXX-1)*WFV,Y+(YYY+3)*WFV)-STEP(1*WFV,-3*WFV)-STEP(4*WFV,-1*WFV)-STEP(-1*WFV,5*WFV)-STEP(-4*WFV,-1*WFV),0,PSET,F,PP$:RETURN
  547. 18260 *WFY06:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(1*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-3*WFV,0)-STEP(-1*WFV,-3*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  548. 18270 *WFY07:CONNECT (X+(XXX-1)*WFV,Y+(YYY+1)*WFV)-STEP(2*WFV,-1*WFV)-STEP(3*WFV,0)-STEP(0,3*WFV)-STEP(-3*WFV,0)-STEP(-2*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  549. 18280 *WFX1:ON YY+1 GOTO *WFY10,*WFY11,*WFY12,*WFY13,*WFY14,*WFY15,*WFY16,*WFY17
  550. 18290 *WFY10:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,-1*WFV)-STEP(2*WFV,4*WFV)-STEP(-6*WFV,2*WFV)-STEP(0,-5*WFV),0,PSET,F,PP$:RETURN
  551. 18300 *WFY11:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(6*WFV,-2*WFV)-STEP(-2*WFV,5*WFV)-STEP(-2*WFV,2*WFV)-STEP(-3*WFV,-1*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  552. 18310 *WFY12:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,1*WFV)-STEP(2*WFV,3*WFV)-STEP(-6*WFV,0)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  553. 18320 *WFY13:CONNECT (X+(XXX-1)*WFV,Y+(YYY+3)*WFV)-STEP(2*WFV,-3*WFV)-STEP(3*WFV,0)-STEP(0,3*WFV)-STEP(-2*WFV,1*WFV)-STEP(-3*WFV,-1*WFV),0,PSET,F,PP$:RETURN
  554. 18330 *WFY14:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,1*WFV)-STEP(2*WFV,4*WFV)-STEP(-2*WFV,0)-STEP(-2*WFV,-1*WFV)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  555. 18340 *WFY15:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(2*WFV,1*WFV)-STEP(2*WFV,0)-STEP(-1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(1*WFV,-5*WFV),0,PSET,F,PP$:RETURN
  556. 18350 *WFY16:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(2*WFV,1*WFV)-STEP(-2*WFV,3*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-1*WFV),0,PSET,F,PP$:RETURN
  557. 18360 *WFY17:CONNECT (X+(XXX)*WFV,Y+(YYY-3)*WFV)-STEP(3*WFV,2*WFV)-STEP(1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(0,-6*WFV),0,PSET,F,PP$:RETURN
  558. 18370 *WFX2:ON YY+1 GOTO *WFY20,*WFY21,*WFY22,*WFY23,*WFY24,*WFY25,*WFY26,*WFY27
  559. 18380 *WFY20:CONNECT (X+(XXX)*WFV,Y+(YYY-2)*WFV)-STEP(5*WFV,1*WFV)-STEP(-1*WFV,4*WFV)-STEP(-2*WFV,-1*WFV)-STEP(-2*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  560. 18390 *WFY21:CONNECT (X+(XXX+2)*WFV,Y+(YYY-2)*WFV)-STEP(2*WFV,1*WFV)-STEP(1*WFV,4*WFV)-STEP(-1*WFV,1*WFV)-STEP(-4*WFV,-1*WFV)-STEP(2*WFV,-5*WFV),0,PSET,F,PP$:RETURN
  561. 18400 *WFY22:CONNECT (X+(XXX-2)*WFV,Y+(YYY+1)*WFV)-STEP(2*WFV,-2*WFV)-STEP(4*WFV,1*WFV)-STEP(-1*WFV,3*WFV)-STEP(-3*WFV,1*WFV)-STEP(-2*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  562. 18410 *WFY23:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(1*WFV,3*WFV)-STEP(0,1*WFV)-STEP(-1*WFV,1*WFV)-STEP(-3*WFV,-1*WFV)-STEP(0,-3*WFV),0,PSET,F,PP$:RETURN
  563. 18420 *WFY24:CONNECT (X+(XXX-2)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,-1*WFV)-STEP(3*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-3*WFV,1*WFV)-STEP(-2*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  564. 18430 *WFY25:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(1*WFV,3*WFV)-STEP(-3*WFV,2*WFV)-STEP(-2*WFV,-1*WFV)-STEP(1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  565. 18440 *WFY26:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-2*WFV)-STEP(1*WFV,2*WFV)-STEP(-2*WFV,4*WFV)-STEP(-4*WFV,-1*WFV)-STEP(2*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  566. 18450 *WFY27:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(2*WFV,3*WFV)-STEP(-5*WFV,-1*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  567. 18460 *WFX3:ON YY+1 GOTO *WFY30,*WFY31,*WFY32,*WFY33,*WFY34,*WFY35,*WFY36,*WFY37
  568. 18470 *WFY30:CONNECT (X+(XXX+1)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(-1*WFV,2*WFV)-STEP(-4*WFV,1*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  569. 18480 *WFY31:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,-1*WFV)-STEP(1*WFV,4*WFV)-STEP(-1*WFV,2*WFV)-STEP(-3*WFV,-1*WFV)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  570. 18490 *WFY32:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-1*WFV)-STEP(3*WFV,1*WFV)-STEP(1*WFV,2*WFV)-STEP(-3*WFV,2*WFV)-STEP(-3*WFV,-1*WFV)-STEP(1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  571. 18500 *WFY33:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,1*WFV)-STEP(2*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-4*WFV,-2*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  572. 18510 *WFY34:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-1*WFV)-STEP(0,-1*WFV)-STEP(4*WFV,2*WFV)-STEP(1*WFV,2*WFV)-STEP(-6*WFV,1*WFV)-STEP(0,-3*WFV),0,PSET,F,PP$:RETURN
  573. 18520 *WFY35:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(6*WFV,-1*WFV)-STEP(-2*WFV,5*WFV)-STEP(-2*WFV,1*WFV)-STEP(-1*WFV,-2*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  574. 18530 *WFY36:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,-1*WFV)-STEP(1*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-5*WFV,1*WFV)-STEP(2*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  575. 18540 *WFY37:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(5*WFV,-1*WFV)-STEP(1*WFV,5*WFV)-STEP(-4*WFV,-1*WFV)-STEP(-2*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  576. 18550 *WFX4:ON YY+1 GOTO *WFY40,*WFY41,*WFY42,*WFY43,*WFY44,*WFY45,*WFY46,*WFY47
  577. 18560 *WFY40:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(-1*WFV,4*WFV)-STEP(-4*WFV,-1*WFV)-STEP(1*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  578. 18570 *WFY41:CONNECT (X+(XXX)*WFV,Y+(YYY-2)*WFV)-STEP(4*WFV,1*WFV)-STEP(2*WFV,1*WFV)-STEP(-2*WFV,4*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  579. 18580 *WFY42:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-2*WFV)-STEP(3*WFV,2*WFV)-STEP(1*WFV,2*WFV)-STEP(-1*WFV,2*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  580. 18590 *WFY43:CONNECT (X+(XXX-2)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-2*WFV)-STEP(3*WFV,2*WFV)-STEP(1*WFV,2*WFV)-STEP(-1*WFV,2*WFV)-STEP(-4*WFV,-3*WFV)-STEP(-2*WFV,-1*WFV),0,PSET,F,PP$:RETURN
  581. 18600 *WFY44:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(0,-3*WFV)-STEP(4*WFV,3*WFV)-STEP(0,4*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  582. 18610 *WFY45:CONNECT (X+(XXX-1)*WFV,Y+(YYY+3)*WFV)-STEP(2*WFV,-5*WFV)-STEP(3*WFV,2*WFV)-STEP(-1*WFV,2*WFV)-STEP(-3*WFV,2*WFV)-STEP(-1*WFV,-1*WFV),0,PSET,F,PP$:RETURN
  583. 18620 *WFY46:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-2*WFV)-STEP(2*WFV,2*WFV)-STEP(-1*WFV,4*WFV)-STEP(-4*WFV,-1*WFV)-STEP(0,-3*WFV),0,PSET,F,PP$:RETURN
  584. 18630 *WFY47:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(-1*WFV,-5*WFV),0,PSET,F,PP$:RETURN
  585. 18640 *WFX5:ON YY+1 GOTO *WFY50,*WFY51,*WFY52,*WFY53,*WFY54,*WFY55,*WFY56,*WFY57
  586. 18650 *WFY50:CONNECT (X+(XXX+1)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-1*WFV,2*WFV)-STEP(-4*WFV,-2*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  587. 18660 *WFY51:CONNECT (X+(XXX+2)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,1*WFV)-STEP(1*WFV,3*WFV)-STEP(-5*WFV,0)-STEP(2*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  588. 18670 *WFY52:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(5*WFV,0)-STEP(-1*WFV,4*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  589. 18680 *WFY53:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-2*WFV)-STEP(3*WFV,2*WFV)-STEP(0,4*WFV)-STEP(-1*WFV,0)-STEP(-2*WFV,-2*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  590. 18690 *WFY54:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-2*WFV)-STEP(2*WFV,2*WFV)-STEP(1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(0,-4*WFV),0,PSET,F,PP$:RETURN
  591. 18700 *WFY55:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(0,4*WFV)-STEP(-3*WFV,1*WFV)-STEP(-2*WFV,-2*WFV)-STEP(1*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  592. 18710 *WFY56:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(1*WFV,1*WFV)-STEP(-1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  593. 18720 *WFY57:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(1*WFV,5*WFV)-STEP(-4*WFV,-1*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  594. 18730 *WFX6:ON YY+1 GOTO *WFY60,*WFY61,*WFY62,*WFY63,*WFY64,*WFY65,*WFY66,*WFY67
  595. 18740 *WFY60:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(0,6*WFV)-STEP(-3*WFV,-2*WFV)-STEP(0,-3*WFV),0,PSET,F,PP$:RETURN
  596. 18750 *WFY61:CONNECT (X+(XXX)*WFV,Y+(YYY+1)*WFV)-STEP(1*WFV,-2*WFV)-STEP(3*WFV,2*WFV)-STEP(-3*WFV,3*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  597. 18760 *WFY62:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,1*WFV)-STEP(2*WFV,4*WFV)-STEP(-2*WFV,0)-STEP(-3*WFV,-1*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  598. 18770 *WFY63:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,1*WFV)-STEP(1*WFV,2*WFV)-STEP(-4*WFV,1*WFV)-STEP(0,-4*WFV),0,PSET,F,PP$:RETURN
  599. 18780 *WFY64:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,0)-STEP(4*WFV,-1*WFV)-STEP(0,4*WFV)-STEP(-4*WFV,0)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  600. 18790 *WFY65:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,0)-STEP(1*WFV,4*WFV)-STEP(-3*WFV,1*WFV)-STEP(-1*WFV,-1*WFV)-STEP(0,-4*WFV),0,PSET,F,PP$:RETURN
  601. 18800 *WFY66:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(1*WFV,5*WFV)-STEP(-5*WFV,-1*WFV)-STEP(1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  602. 18810 *WFY67:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(5*WFV,1*WFV)-STEP(-1*WFV,3*WFV)-STEP(-3*WFV,1*WFV)-STEP(-1*WFV,-5*WFV),0,PSET,F,PP$:RETURN
  603. 18820 *WFX7:ON YY+1 GOTO *WFY70,*WFY71,*WFY72,*WFY73,*WFY74,*WFY75,*WFY76,*WFY77
  604. 18830 *WFY70:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,3*WFV)-STEP(1*WFV,6*WFV)-STEP(-4*WFV,-3*WFV)-STEP(0,-6*WFV),0,PSET,F,PP$:RETURN
  605. 18840 *WFY71:CONNECT (X+(XXX)*WFV,Y+(YYY+1)*WFV)-STEP(4*WFV,3*WFV)-STEP(-1*WFV,1*WFV)-STEP(-4*WFV,0)-STEP(-2*WFV,-1*WFV)-STEP(3*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  606. 18850 *WFY72:CONNECT (X+(XXX-1)*WFV,Y+(YYY+1)*WFV)-STEP(4*WFV,0)-STEP(1*WFV,3*WFV)-STEP(-3*WFV,1*WFV)-STEP(-2*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  607. 18860 *WFY73:CONNECT (X+(XXX-1)*WFV,Y+(YYY+1)*WFV)-STEP(2*WFV,0)-STEP(3*WFV,-1*WFV)-STEP(-1*WFV,4*WFV)-STEP(-3*WFV,-1*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN
  608. 18870 *WFY74:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,1*WFV)-STEP(1*WFV,4*WFV)-STEP(-4*WFV,-1*WFV)-STEP(0,-4*WFV),0,PSET,F,PP$:RETURN
  609. 18880 *WFY75:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(1*WFV,0)-STEP(4*WFV,1*WFV)-STEP(-1*WFV,3*WFV)-STEP(-3*WFV,0)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN
  610. 18890 *WFY76:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,0)-STEP(1*WFV,2*WFV)-STEP(1*WFV,3*WFV)-STEP(-2*WFV,1*WFV)-STEP(-2*WFV,-1*WFV)-STEP(-1*WFV,-5*WFV),0,PSET,F,PP$:RETURN
  611. 18900 *WFY77:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,1*WFV)-STEP(2*WFV,2*WFV)-STEP(-2*WFV,3*WFV)-STEP(-3*WFV,-3*WFV)-STEP(1*WFV,-3*WFV),0,PSET,F,PP$:RETURN
  612. 18910 *TESTPATTERN:A=1
  613. 18920 FOR X=0 TO 7:FOR Y=0 TO 7
  614. 18930  LINE (32*WFV+X*4*WFV,Y*4*WFV)-(32*WFV+(X+1)*4*WFV-1,(Y+1)*4*WFV-1),PSET,%A,BF
  615. 18940  A=A+1
  616. 18950 NEXT:NEXT:GOSUB *VW1:RETURN
  617. 19000 *WFCMD:ON WFCMD+1 GOTO *WFC0,*WFC1,*WFC2,*WFC3:RETURN
  618. 19010 *WFC0:PP$=STRING$(8,CHR$(XX+YY*8)):RETURN
  619. 19020 *WFC1:P$=FNMP$(CP&(1))+FNMP$(CP&(2)):PP$=P$+P$:P$=FNMP$(CP&(2))+FNMP$(CP&(1)):PP$=PP$+P$+P$:RETURN
  620. 19030 *WFC2:PP$=STRING$(8,RIGHT$(FNMP$(CP&(WFV+1)),1)):RETURN
  621. 19040 *WFC3:G&=0:B&=0:R&=0
  622. 19050 FOR A=0 TO CP:WPP%(0)=VAL("&H"+LEFT$(RIGHT$("00000000"+HEX$(CP&(A)),8),2)):WPP%(1)=(CP&(A) AND &HFF0000)\65536:WPP%(2)=(CP&(A) AND &HFF00)\256:WPP%(3)=CP&(A) AND &HFF
  623. 19060  FOR I=0 TO 3
  624. 19070  G&=G&+((WPP%(I) AND &HE0)\32):R&=R&+((WPP%(I) AND &H1C)\4):B&=B&+(WPP%(I) AND &H3)
  625. 19080  NEXT
  626. 19090 NEXT:A=(CP+1)*4:WPP=(G&/A)*32+(R&/A)*4+(B&/A)
  627. 19140 PP$=STRING$(8,CHR$(WPP)):RETURN
  628. 19200 *WFMCMD:ON WFCMD+1 GOTO *WFC0,*WFCM1,*WFCM2,*WFC3:RETURN
  629. 19220 *WFCM1:P$=FNP1$(CP&(0))+FNP2$(CP&(0)):PP$=P$+P$+P$+P$:P$=FNP2$(CP&(0))+FNP1$(CP&(0)):PP$=PP$+P$+P$+P$+P$:RETURN
  630. 19230 *WFCM2:PP$=STRING$(8,RIGHT$(FNP1$(CP&(0)),1)):RETURN
  631. 19500 *PMETAL
  632. 19510 A&=CALLM(OFFSET&,8):IF (A& AND 16)=16 THEN *MESH
  633. 19520 GSV=2:GS=24:FOR A=0 TO GS:GS!(A)=A+8:NEXT:M$=" ＜ 穴の大きさ ＞":GOSUB *GETSIZE:WFV=GS!(GSV)
  634. 19530 GOSUB *VW3:GET@A (0,0)-(639,479),GB%:LINE (0,0)-(639,479),PSET,0,BF:A&=CALLM(OFFSET&,8)
  635. 19540 FOR Y=-WFV TO 479 STEP WFV*2:FOR X=-WFV TO 639 STEP WFV*2:CIRCLE (X,Y),WFV\2,7,,,,F,PSET:CIRCLE (X+WFV,Y+WFV),WFV\2,7,,,,F,PSET:IF INKEY$=CHR$(27) THEN X=1000:Y=1000
  636. 19545 NEXT:NEXT:IF X>990 THEN RETURN
  637. 19550 GET@ (0,0)-(639,479),WG%,0:PUT@A (0,0)-(639,479),GB%,AND:PUT@ (0,0)-(639,479),WG%,PSET,%COLV:IF (A& AND 16)<>16 THEN RETURN
  638. 19560 IF (A& AND 4)=4 THEN *PMETALPR
  639. 19570 PASTEL 64:DEF PEN 0,WFV\4:FOR Y=-WFV TO 479 STEP WFV*2:FOR X=-WFV TO 639 STEP WFV*2:CIRCLE (X,Y),WFV\2,7,,,,,PASTEL:CIRCLE (X+WFV,Y+WFV),WFV\2,7,,,,,PASTEL:IF INKEY$=CHR$(27) THEN X=1000:Y=1000
  640. 19575 NEXT:NEXT:RETURN
  641. 19580 *PMETALPR:CP&(0)=&HCCCC:CP&(1)=&H3333:FOR A=1-(WFV\8) TO WFV\8:FOR Y=-WFV TO 479 STEP WFV*2:FOR X=-WFV TO 639 STEP WFV*2:CIRCLE (X,Y),WFV\2+A,7,,,,,,CP&(A AND 1):CIRCLE (X+WFV,Y+WFV),WFV\2+A,7,,,,,,CP&(A AND 1):IF INKEY$=CHR$(27) THEN X=1000:Y=1000
  642. 19590 NEXT:NEXT:RETURN
  643. 19600 *MESH
  644. 19610 GSV=6:GS=11:FOR A=0 TO GS:GS!(A)=(A+1)*8:NEXT:M$=" ＜  線の間隔  ＞":GOSUB *GETSIZE:WFV=GS!(GSV):B&=A&:A&=CALLM(OFFSET&,8)
  645. 19620 GOSUB *VW3:A=(GSV\4)+1:IF (B& AND 4)<>4 THEN PASTEL 128:DEF PEN 0,A+2:OCOLV=0:SWAP OCOLV,COLV:GOSUB *MESH_WRT_P:SWAP OCOLV,COLV:IF X>990 THEN RETURN
  646. 19630 PASTEL 256:DEF PEN 0,A:GOSUB *MESH_WRT_P:IF X>990 THEN RETURN
  647. 19640 IF (A& AND 20)=0 THEN RETURN
  648. 19650 IF (A& AND 4)<>4 THEN PASTEL 64:DEF PEN 0,A*3:GOSUB *MESH_WRT_P:RETURN
  649. 19660 DEF PEN 0,1:CP&(0)=&HCCCC:CP&(1)=&H3333:FOR I=-A TO A+A:FOR Y=-WFV TO 479+WFV STEP WFV+A*2:FOR X=0 TO 639+WFV STEP WFV+A
  650. 19670  CONNECT (X+I,Y)-STEP(WFV\2-A*4,WFV\2-A*4)-STEP(A,A)-STEP(A*3,A*3)-STEP(0,A*2)-STEP(-A*3,A*3)-STEP(-A,A)-STEP(-(WFV\2-A*4),WFV\2-A*4)-STEP(0,A*2),%COLV,PSET,N,CP&(I AND 1)
  651. 19680  CONNECT (X+WFV-1+I,Y+1)-STEP(-(WFV\2-A*4),WFV\2-A*4)-STEP(-A,A)-STEP(-A*3,A*3)-STEP(0,A)-STEP(A*3,A*3)-STEP(A,A)-STEP(WFV\2-A*4,WFV\2-A*4)-STEP(0,A*2),%COLV,PSET,N,CP&(I AND 1):IF INKEY$=CHR$(27) THEN X=1000:Y=1000:I=1000
  652. 19690 NEXT:NEXT:NEXT:RETURN
  653. 19700 *MESH_WRT_P:FOR Y=-WFV TO 479+WFV STEP WFV+A*2:FOR X=0 TO 639+WFV STEP WFV+A
  654. 19710  CONNECT (X,Y)-STEP(WFV\2-A*4,WFV\2-A*4)-STEP(A,A)-STEP(A*3,A*3)-STEP(0,A*2)-STEP(-A*3,A*3)-STEP(-A,A)-STEP(-(WFV\2-A*4),WFV\2-A*4)-STEP(0,A*2),%COLV,PASTEL
  655. 19720  CONNECT (X+WFV-1,Y+1)-STEP(-(WFV\2-A*4),WFV\2-A*4)-STEP(-A,A)-STEP(-A*3,A*3)-STEP(0,A)-STEP(A*3,A*3)-STEP(A,A)-STEP(WFV\2-A*4,WFV\2-A*4)-STEP(0,A*2),%COLV,PASTEL:IF INKEY$=CHR$(27) THEN X=1000:Y=1000
  656. 19730 NEXT:NEXT:RETURN
  657. 19800 *PILE
  658. 19810 GOSUB *MENUWRT:OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP:SWAP OCOLV,COLV:SYMBOL (10+MENX,372),"ＰＡＳＴＥＬ",1,1,0:SYMBOL (10+MENX,392),"ＯＲ",1,1,0:SYMBOL (10+MENX,412),"ＡＮＤ",1,1,0
  659. 19820 SYMBOL (10+MENX,432),"ＸＯＲ",1,1,0:SYMBOL (10+MENX,452),"ＭＡＴＴＥ",1,1,0:MOUSE 1,,,1
  660. 19830 *PGS_LOOP:MFLG=0:WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2):WEND:IF (MFLG AND 2)=2 THEN WHILE MOUSE(6,1)=0:WEND:GOSUB *COLDISP:GOSUB *MENUOFF:RETURN 
  661. 19840 WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0):MY=MOUSE(1)
  662. 19850 IF MX<MENX+7 OR MY<372 OR MX>MENX+150 OR MY>467 THEN *PGS_LOOP
  663. 19860 MY=(MY-372)\20:IF MY<0 OR MY>4 THEN *PGS_LOOP
  664. 19870 GOSUB *MENUOFF:GOSUB *EXCHG_BUF:ON MY+1 GOSUB *PPAS,*POR,*PAND,*PXOR,*PMAT
  665. 19880 RETURN
  666. 19900 *PPAS:PASTEL 128:PUT@A (0,0)-(639,479),GB%,PASTEL:RETURN
  667. 19910 *POR:PUT@A (0,0)-(639,479),GB%,OR:RETURN
  668. 19920 *PAND:PUT@A (0,0)-(639,479),GB%,AND:RETURN
  669. 19930 *PXOR:PUT@A (0,0)-(639,479),GB%,XOR:RETURN
  670. 19940 *PMAT:PUT@A (0,0)-(639,479),GB%,MATTE,,,%COLV:RETURN
  671. 20000 *STAMP:IF STF<>0 THEN *DO_STAMP
  672. 20010 OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP:SWAP OCOLV,COLV:GOSUB *VW1:PUT@A (928,0)-(1023,479),STMP%,PSET
  673. 20020 GET@ (1008,0)-(1023,15),STPM0%,0:PUT@ (13+MENX,388)-(28+MENX,403),STPM0%,PSET,0:LINE (12+MENX,387)-(29+MENX,404),PSET,0,B:PUT@ (30+MENX,388)-(45+MENX,403),STPM0%,PSET,0
  674. 20030 GET@ (1008,240)-(1023,255),STPM0%,0:PUT@ (47+MENX,388)-(62+MENX,403),STPM0%,PSET,0:LINE (46+MENX,387)-(63+MENX,404),PSET,0,B:PUT@ (64+MENX,388)-(79+MENX,403),STPM0%,PSET,0
  675. 20040 GET@ (992,0)-(1007,15),STPM0%,0:PUT@ (81+MENX,388)-(96+MENX,403),STPM0%,PSET,0:LINE (80+MENX,387)-(97+MENX,404),PSET,0,B:PUT@ (98+MENX,388)-(113+MENX,403),STPM0%,PSET,0
  676. 20050 GET@ (992,240)-(1007,255),STPM0%,0:PUT@ (115+MENX,388)-(130+MENX,403),STPM0%,PSET,0:LINE (114+MENX,387)-(131+MENX,404),PSET,0,B:PUT@ (132+MENX,388)-(147+MENX,403),STPM0%,PSET,0
  677. 20060 SYMBOL (MENX+7,368),"Stamp Panel",1,1,0,,,3,2:SYMBOL (MENX+8,368),"Stamp Panel",1,1,0,,,3,2
  678. 20070 GET@ (960,0)-(975,15),STPM0%,0:PUT@ (13+MENX,422)-(28+MENX,437),STPM0%,PSET,0:LINE (12+MENX,421)-(29+MENX,438),PSET,0,B:PUT@ (30+MENX,422)-(45+MENX,437),STPM0%,PSET,0
  679. 20080 GET@ (960,240)-(975,255),STPM0%,0:PUT@ (47+MENX,422)-(62+MENX,437),STPM0%,PSET,0:LINE (46+MENX,421)-(63+MENX,438),PSET,0,B:PUT@ (64+MENX,422)-(79+MENX,437),STPM0%,PSET,0
  680. 20500 *STS_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1)
  681. 20510 IF (MY-387) MOD 34>17 THEN *STS_LOOP
  682. 20520 MX=(MX-12) \ 17:MY=(MY-387) \ 34:IF MX<0 OR MX>7 OR MY<0 OR MY>1 THEN *STS_LOOP
  683. 20530 IF MX>3 AND MY=1 THEN *STS_LOOP
  684. 20540 STF=(MX MOD 2)+(MY*2)+1
  685. 20550 ON STF GOSUB *MONO_STAMP_GET,*MONO_STAMP2_GET,*MONO_STAMPBIG_GET,*MONO_STAMPBIG2_GET',*COL_STAMP_GET
  686. 20560 *DO_STAMP:STA=1:GOSUB *UNDOGET:ON STF GOSUB *MONO_STAMP,*MONO_STAMP2,*MONO_STAMPBIG,*MONO_STAMPBIG2 ',*COL_STAMP
  687. 20570 GOSUB *MENUWRT:RETURN
  688. 20600 *MONO_STAMP_GET
  689. 20610 A=MX:MX=1008-((A \ 4)*16):MY=((A\2) MOD 2)*240
  690. 20620 GET@ (MX,MY)-(MX+15,MY+15),STPM0%,0:GET@ (MX,MY+16)-(MX+15,MY+31),STPM1%,0:GET@ (MX,MY+32)-(MX+15,MY+47),STPM2%,0:GET@ (MX,MY+48)-(MX+15,MY+63),STPM3%,0
  691. 20630 GET@ (MX,MY+64)-(MX+15,MY+79),STPM4%,0:GET@ (MX,MY+80)-(MX+15,MY+95),STPM5%,0:GET@ (MX,MY+96)-(MX+15,MY+111),STPM6%,0:GET@ (MX,MY+112)-(MX+15,MY+127),STPM7%,0
  692. 20640 GET@ (MX,MY+128)-(MX+15,MY+143),STPM8%,0:GET@ (MX,MY+144)-(MX+15,MY+159),STPM9%,0:GET@ (MX,MY+160)-(MX+15,MY+175),STPM10%,0:GET@ (MX,MY+176)-(MX+15,MY+191),STPM11%,0
  693. 20650 GET@ (MX,MY+192)-(MX+15,MY+207),STPM12%,0:GET@ (MX,MY+208)-(MX+15,MY+223),STPM13%,0:GET@ (MX,MY+224)-(MX+15,MY+239),STPM14%,0:RETURN
  694. 20700 *MONO_STAMP2_GET
  695. 20710 GOSUB *MONO_STAMP_GET:GET@A (MX,MY)-(MX+15,MY+239),STP0%:RETURN
  696. 21000 *MONO_STAMP
  697. 21010 GOSUB *MOS_WAIT:MOUSE 1,,,0:WHILE MOUSE(6,0)=0:GOSUB *MSTAMP:GOSUB *PAL_SHIFT:A&=CALLM(OFFSET&,8):WAIT A&
  698. 21020 WEND:RETURN
  699. 21030 *MSTAMP
  700. 21040 GOSUB *MXY:ON STA GOSUB *MST0,*MST1,*MST2,*MST3,*MST4,*MST5,*MST6,*MST7,*MST8,*MST9,*MST10,*MST11,*MST12,*MST13,*MST14
  701. 21050 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  702. 21060 STA=STA+1:IF STA>15 THEN STA=1
  703. 21070 RETURN
  704. 21100 *MST0:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM0%,PSET,%COLV:RETURN
  705. 21110 *MST1:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM1%,PSET,%COLV:RETURN
  706. 21120 *MST2:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM2%,PSET,%COLV:RETURN
  707. 21130 *MST3:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM3%,PSET,%COLV:RETURN
  708. 21140 *MST4:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM4%,PSET,%COLV:RETURN
  709. 21150 *MST5:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM5%,PSET,%COLV:RETURN
  710. 21160 *MST6:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM6%,PSET,%COLV:RETURN
  711. 21170 *MST7:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM7%,PSET,%COLV:RETURN
  712. 21180 *MST8:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM8%,PSET,%COLV:RETURN
  713. 21190 *MST9:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM9%,PSET,%COLV:RETURN
  714. 21200 *MST10:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM10%,PSET,%COLV:RETURN
  715. 21210 *MST11:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM11%,PSET,%COLV:RETURN
  716. 21220 *MST12:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM12%,PSET,%COLV:RETURN
  717. 21230 *MST13:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM13%,PSET,%COLV:RETURN
  718. 21240 *MST14:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM14%,PSET,%COLV:RETURN
  719. 21500 *MONO_STAMP2
  720. 21510 GOSUB *MOS_WAIT:MOUSE 1,,,0:WHILE MOUSE(6,0)=0:GOSUB *MSTAMP2:GOSUB *PAL_SHIFT:A&=CALLM(OFFSET&,8):WAIT A&
  721. 21520 WEND:RETURN
  722. 21530 *MSTAMP2
  723. 21540 GOSUB *MXY:PUT@A (MX-8,MY-8)-(MX+7,MY+7),STP0%,MATTE,,,%1,128*(STA-1):ON STA GOSUB *MST0,*MST1,*MST2,*MST3,*MST4,*MST5,*MST6,*MST7,*MST8,*MST9,*MST10,*MST11,*MST12,*MST13,*MST14
  724. 21550 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  725. 21560 STA=STA+1:IF STA>15 THEN STA=1
  726. 21570 RETURN
  727. 22000 *MONO_STAMPBIG_GET
  728. 22010 A=MX:MX=960-((A \ 4)*32):MY=((A\2) MOD 2)*240+16
  729. 22020 GET@ (MX,MY)-(MX+31,MY+31),STPM0%,0:GET@ (MX,MY+32)-(MX+31,MY+63),STPM1%,0:GET@ (MX,MY+64)-(MX+31,MY+95),STPM2%,0:GET@ (MX,MY+96)-(MX+31,MY+127),STPM3%,0
  730. 22030 GET@ (MX,MY+128)-(MX+31,MY+159),STPM4%,0:GET@ (MX,MY+160)-(MX+31,MY+191),STPM5%,0:GET@ (MX,MY+192)-(MX+31,MY+223),STPM6%,0
  731. 22040 RETURN
  732. 22100 *MONO_STAMPBIG2_GET
  733. 22110 GOSUB *MONO_STAMPBIG_GET:GET@A (MX,MY)-(MX+31,MY+223),STP0%:RETURN
  734. 22500 *MONO_STAMPBIG
  735. 22510 GOSUB *MOS_WAIT:MOUSE 1,,,0:WHILE MOUSE(6,0)=0:GOSUB *MSTAMPBIG:GOSUB *PAL_SHIFT:A&=CALLM(OFFSET&,8):WAIT A&
  736. 22520 WEND:RETURN
  737. 22530 *MSTAMPBIG
  738. 22540 GOSUB *MXY:ON STA GOSUB *MSTB0,*MSTB1,*MSTB2,*MSTB3,*MSTB4,*MSTB5,*MSTB6
  739. 22550 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  740. 22560 STA=STA+1:IF STA>7 THEN STA=1
  741. 22570 RETURN
  742. 22600 *MSTB0:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM0%,PSET,%COLV:RETURN
  743. 22610 *MSTB1:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM1%,PSET,%COLV:RETURN
  744. 22620 *MSTB2:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM2%,PSET,%COLV:RETURN
  745. 22630 *MSTB3:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM3%,PSET,%COLV:RETURN
  746. 22640 *MSTB4:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM4%,PSET,%COLV:RETURN
  747. 22650 *MSTB5:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM5%,PSET,%COLV:RETURN
  748. 22660 *MSTB6:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM6%,PSET,%COLV:RETURN
  749. 22800 *MONO_STAMPBIG2
  750. 22810 GOSUB *MOS_WAIT:MOUSE 1,,,0:WHILE MOUSE(6,0)=0:GOSUB *MSTAMPBIG2:GOSUB *PAL_SHIFT:A&=CALLM(OFFSET&,8):WAIT A&
  751. 22820 WEND:RETURN
  752. 22830 *MSTAMPBIG2
  753. 22840 GOSUB *MXY:PUT@A (MX-16,MY-16)-(MX+15,MY+15),STP0%,MATTE,,,%1,512*(STA-1):ON STA GOSUB *MSTB0,*MSTB1,*MSTB2,*MSTB3,*MSTB4,*MSTB5,*MSTB6
  754. 22850 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0
  755. 22860 STA=STA+1:IF STA>7 THEN STA=1
  756. 22870 RETURN
  757. 23000 *TEXT:RETURN
  758. 23010 GOSUB *MENUOFF:GET@A (0,240)-(639,359),WG%:GET@A (0,360)-(639,479),MGB%:LINE (0,240)-(639,479),PSET,0,BF,7
  759. 29900 GOSUB *MENUWRT:RETURN
  760. 30000 *FILELOAD
  761. 30010 TM$="ロード":RWFLG=0:ON ERROR GOTO 30250:GOSUB 30020:IF YN=0 THEN GOSUB *CDCONTT:RETURN ELSE GOSUB *CHECK_COMP:IF YN=0 THEN GOSUB *CDCONTT:RETURN ELSE LOAD@ DFD$+DFF$:GOSUB *GET_PALETTE:GOSUB *CDCONTT:RETURN
  762. 30020 GOSUB *INPUT:YN=FDFLG:IF YN=0 THEN RETURN
  763. 30030 ON ERROR GOTO 30250:IF INSTR(DFF$,".")=0 THEN DFF$=LEFT$(DFF$,8)+".TIF":GOTO 30060
  764. 30040 A=INSTR(DFF$,"."):IF LEN(DFF$)-A>3 OR A<2 THEN BEEP:YN=0:RETURN
  765. 30050 IF MID$(DFF$,A,4)<>".TIF" THEN DFF$=LEFT$(DFF$,A-1)+".TIF"
  766. 30060 DFF$=PATH$+DFF$:RETURN
  767. 30070 *INPUT
  768. 30080 RADBUT=0:RCMD=1:WC$="*.TIF":FDM$="読み込むTIFファイルを指定して下さい｡"
  769. 30090 GOSUB *FILE_DIALOG:IF FDFLG=0 THEN RETURN ELSE IF RIGHT$(PATH$,1)<>"\" THEN PATH$=PATH$+"\"
  770. 30100 DFD$=DRIVE$:DFF$=F_NAME$:RETURN
  771. 30110 *FILESAVE
  772. 30120 TM$="セーブ":RWFLG=1:ON ERROR GOTO 30250:GOSUB 30130:IF YN=0 THEN GOSUB *CDCONTT:RETURN ELSE SAVE@ DFD$+DFF$,(0,0)-(639,479),(RCMD-1):GOSUB *CDCONTT:RETURN
  773. 30130 GOSUB *INPUT_SAVE:YN=FDFLG:IF YN=0 THEN RETURN
  774. 30140 ON ERROR GOTO 30250:IF INSTR(DFF$,".")=0 THEN DFF$=LEFT$(DFF$,8)+".TIF":GOTO 30170
  775. 30150 A=INSTR(DFF$,"."):IF LEN(DFF$)-A>3 OR A<2 THEN BEEP:YN=0:RETURN
  776. 30160 IF MID$(DFF$,A,4)<>".TIF" THEN DFF$=LEFT$(DFF$,A-1)+".TIF"
  777. 30170 DFF$=PATH$+DFF$:RETURN
  778. 30180 *INPUT_SAVE
  779. 30190 RADBUT=2:RCMD=2:WC$="*.TIF":FDM$="保存するTIFファイルを設定して下さい｡":RADBUT$(0)="パレットなし":RADBUT$(1)="パレットあり":RETFLG(0)=0:RETFLG(1)=0
  780. 30200 GOSUB *FILE_DIALOG:IF FDFLG=0 THEN RETURN ELSE IF RIGHT$(PATH$,1)<>"\" THEN PATH$=PATH$+"\" 
  781. 30210 DFD$=DRIVE$:DFF$=F_NAME$:RETURN
  782. 30220 *ERR_PUT_PIC:MOUSE 4,0,0,639,479:PUT@A (0,0)-(639,479),GB%:RETURN
  783. 30230 *ERR_GET_PIC:LINE (EX,EY)-(EX+300,EY+36),PSET,7,BF,0:RETURN
  784. 30240 *ERR_COMP:M$="現バージョンでは圧縮TIFFは未サポートです":GOSUB 30440:RETURN
  785. 30250 GOSUB *ERR_GET_PIC:ERRV=ERR:IF ERR=112 THEN M$="256色TIFFではありません":GOSUB 30440:RESUME NEXT
  786. 30260 IF ERR=28 AND ERL=30010 THEN GOSUB *ERR_COMP:RESUME NEXT
  787. 30270 IF ERR=64 THEN M$="指定のファイルは既に存在しています":GOSUB 30390:IF YN=0 THEN RESUME NEXT ELSE KILL DFD$+DFF$:RESUME
  788. 30280 IF ERR=53 THEN M$="入出力装置に異常が発生しました":GOSUB 30440:RESUME NEXT
  789. 30290 IF ERR=55 THEN M$="ファイルの記述に誤りがあります":GOSUB 30440:RESUME NEXT
  790. 30300 IF ERR=60 THEN M$="指定の入出力装置は使用できません":GOSUB 30440:RESUME NEXT
  791. 30310 IF ERR=63 THEN M$="指定のファイルが見つかりません":GOSUB 30440:RESUME NEXT
  792. 30320 IF ERR=65 THEN M$="ディスクのディレクトリ領域がいっぱいです":GOSUB 30440:RESUME NEXT
  793. 30330 IF ERR=67 THEN M$="ディスクに空き領域がありません":GOSUB 30440:RESUME NEXT
  794. 30340 IF ERR=71 THEN M$="ディスクのファイルの構成が正しくありません":GOSUB 30440:RESUME NEXT
  795. 30350 IF ERR=72 THEN M$="ディスク装置が使用可能な状態になっていません":GOSUB 30440:RESUME NEXT
  796. 30360 IF ERR=73 THEN M$="指定されたディスクは書込が禁止されています":GOSUB 30390:IF YN=0 THEN RESUME NEXT ELSE RESUME
  797. 30370 IF ERR=75 THEN M$="アクセスが拒否されました":GOSUB 30440:RESUME NEXT
  798. 30380 PRINT "エラーが発生しました。 ID =";ERR;" Line =";ERL:END
  799. 30385 *TORIJIK:GOSUB 30420:SYMBOL (EX+170,EY+20),"取消   実行",1,1,7:LINE (EX+170,EY+18)-(EX+225,EY+36),PSET,2,B:LINE (EX+281,EY+18)-(EX+281,EY+36),PSET,2:MOUSE 1,EX+202,EY+24,1:GOTO 30400
  800. 30390 GOSUB 30420:SYMBOL (EX+170,EY+20),"中断   続行",1,1,7:SYMBOL (EX+202,EY+28),"[取消]        [実行]",.5!,.5!,7:LINE (EX+170,EY+18)-(EX+225,EY+36),PSET,2,B:LINE (EX+281,EY+18)-(EX+281,EY+36),PSET,2:MOUSE 1,EX+202,EY+24,1
  801. 30400 MOUSE 4,EX+170,EY+18,EX+281,EY+36:A$="":WHILE MOUSE(2,0)=0 AND A$<>CHR$(13) AND A$<>CHR$(24):A$=INKEY$:WEND:IF A$="" THEN WHILE MOUSE(6,0)=0:WEND:YN=MOUSE(0)\(EX+231):GOSUB *ERR_PUT_PIC:RETURN
  802. 30410 YN=SGN(24-ASC(A$)):GOSUB *ERR_PUT_PIC:RETURN
  803. 30420 ML=KLEN(M$):IF ML<19 THEN SYMBOL (EX+6,EY+2),M$,1,1,7 ELSE IF ML<25 THEN SYMBOL (EX+6,EY+2),M$,.75!,1,7 ELSE SYMBOL (EX+6,EY+2),M$,.5!,1,7
  804. 30430 IF ERRV<>0 THEN SYMBOL (EX+2,EY+20),"Error ID ="+FNF$(ERRV),1,1,7
  805. 30435 LINE (EX,EY+18)-(EX+300,EY+18),PSET,2:RETURN
  806. 30440 GOSUB 30420:SYMBOL (EX+230,EY+20),"確認",1,1,7:LINE (EX+228,EY+18)-(EX+263,EY+36),PSET,2,B:MOUSE 1,EX+246,EY+24,1:MOUSE 4,EX+228,EY+18,EX+263,EY+36:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:GOSUB *ERR_PUT_PIC:RETURN
  807. 30450 LINE (EX+114,EY+1)-(EX+297,EY+17),PSET,0,BF:RETURN
  808. 30460 *CHECK_COMP
  809. 30470  ON ERROR GOTO *CHECK_ERR
  810. 30480  OPEN "I",#1,DFD$+DFF$
  811. 30490  DUM$=INPUT$(&H42,1):DUM$=INPUT$(2,1):CMPFLG%=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256:CLOSE #1
  812. 30500  IF CMPFLG%<>1 THEN GOSUB *ERR_GET_PIC:ERRV=28:GOSUB *ERR_COMP:YN=0:RETURN
  813. 30510  *CHECK_RET
  814. 30520  ON ERROR GOTO 30250:YN=1:RETURN
  815. 30530 *CHECK_ERR
  816. 30540  RESUME *CHECK_RET
  817. 30550 *HUKIDASHI
  818. 30560 ML=LEN(M$)*8+4:IF PPX+ML-1>639 THEN PPX=639-ML
  819. 30570 GET@A (PPX,376)-(PPX+ML,397),WG%:CONNECT (OPPX-20,397)-(OPPX-23,393)-(PPX,393)-(PPX,376)-(PPX+ML,376)-(PPX+ML,393)-(OPPX-16,393)-(OPPX-20,397),PC,PSET,F,0
  820. 30580 SYMBOL (PPX+2,377),M$,1,1,7:RETURN
  821. 30590 *HUKIDASHIOFF
  822. 30600 PUT@A (PPX,376)-(PPX+ML,397),WG%:RETURN
  823. 30610 *MESSAGEW:PC=7:PLAY OFF:M$=M$+"●":GOSUB *HUKIDASHI:PLAY "@29V8O4T120E8C8":WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:GOSUB *HUKIDASHIOFF:RETURN
  824. 35000 *EXCHG_BUFFER
  825. 35010 FOR A=0 TO 14:GET@A (0,A*32)-(639,A*32+31),WG%:PUT@A (0,480)-(639,511),WG%:PUT@A (0,A*32)-(639,A*32+31),GB%,PSET,,,,A*10240:GET@A (0,480)-(639,511),GB%,A*10240:NEXT:RETURN
  826. 40000 *CDSTART
  827. 40010 ON ERROR GOTO *CDERR
  828. 40020 CDINF CDDAT%:CDC=CDDAT%(1):CDMN=CDDAT%(5)
  829. 40030 IF CDC=2 THEN *CDSRET
  830. 40040 *CDSTART_IN:CDSTAT CDDAT%
  831. 40050 IF CDDAT%(1)=1 THEN *CDSRET
  832. 40060 CD PLAY:CDP=0
  833. 40070 *CDSRET
  834. 40080 ON ERROR GOTO 0:RETURN
  835. 40090 *CDCHK:IF INKEY$=CHR$(13) THEN CDP=0
  836. 40100 ON ERROR GOTO *CDERR
  837. 40110 IF CDP<5 THEN CDSTAT CDDAT% ELSE *CDCRET
  838. 40120 IF CDDAT%(1)=1 THEN *CDCRET ELSE CD STOP
  839. 40130 M$="CD演奏が終了しました｡クリックしてください｡":GOSUB *MESSAGEW
  840. 40140 CDP=CDP+1:GOTO *CDSTART
  841. 40150 *CDCRET
  842. 40160 ON ERROR GOTO 0:RETURN
  843. 40170 *CDERR
  844. 40180 IF ERR=53 THEN CDC=0:CDMN=0:RESUME *CDSRET
  845. 40190 IF ERR=5 THEN RESUME *CDSTART
  846. 40200 IF ERR=115 THEN RESUME *CDSTART
  847. 40210 M$="CD ERROR"+STR$(ERR)+"IN"+STR$(ERL):GOSUB *MESSAGEW:RESUME *CDSTOP
  848. 40220 *CDSTOP:IF CDC=0 OR CDC=2 THEN RETURN
  849. 40230 ON ERROR GOTO *CDERR:CD STOP:ON ERROR GOTO 0:RETURN
  850. 40240 *CDPAUSE:IF CDC=0 OR CDC=2 THEN RETURN
  851. 40250 ON ERROR GOTO *CDERR:CD PAUSE:ON ERROR GOTO 0:RETURN
  852. 40260 *CDCONT:IF CDC=0 OR CDC=2 THEN RETURN
  853. 40270 ON ERROR GOTO *CDERR:CD CONT:ON ERROR GOTO 0:RETURN
  854. 40280 *CDNEXT:IF CDC=0 OR CDC=2 THEN RETURN ELSE ON ERROR GOTO *CDERR
  855. 40290 CDINF CDDAT%:CDMN=CDDAT%(5)
  856. 40300 CDSTAT CDDAT%:IF CDDAT%(1)=0 THEN CPN=0 ELSE CPN=CDDAT%(5)
  857. 40310 CPN=CPN+1:IF CDMN<CPN THEN CPN=CDC
  858. 40320 CD PLAY CPN,CDMN:ON ERROR GOTO 0:RETURN
  859. 40330 *CDPREV:IF CDC=0 OR CDC=2 THEN RETURN ELSE ON ERROR GOTO *CDERR
  860. 40340 CDINF CDDAT%:CDMN=CDDAT%(5)
  861. 40350 CDSTAT CDDAT%:IF CDDAT%(1)=0 THEN CPN=CDMN+1 ELSE CPN=CDDAT%(5)
  862. 40360 CPN=CPN-1:IF CPN<CDC THEN CPN=CDMN
  863. 40370 CD PLAY CPN,CDMN:ON ERROR GOTO 0:RETURN
  864. 40380 *CDGETT:IF CDC=0 OR CDC=2 THEN RETURN ELSE ON ERROR GOTO *CDERR
  865. 40390 CDSTAT CDDAT%:IF CDDAT%(1)=0 THEN CPN=0:RETURN ELSE CPN=CDDAT%(5)
  866. 40400 CDT%(0)=CDDAT%(2):CDT%(1)=CDDAT%(3):CDT%(2)=CDDAT%(4):GOTO *CDSTOP
  867. 40410 *CDCONTT:IF CDC=0 OR CDC=2 OR CPN=0 THEN RETURN ELSE ON ERROR GOTO *CDERR
  868. 40420 CDINF CDDAT%:CDC=CDDAT%(1):CDMN=CDDAT%(5)
  869. 40430 IF CDC=2 THEN *CDSRET
  870. 40440 CDSTAT CDDAT%:IF CDDAT%(1)=1 THEN *CDSRET
  871. 40450 CD PLAY (CDT%(0),CDT%(1),CDT%(2)):CDP=0:GOTO *CDSRET
  872. 41000 *PAL_INI
  873. 41010 A=0:FOR G=0 TO 7:FOR R=0 TO 7:FOR B=0 TO 3:PAL%(A,0)=G*32+31*SGN(G):PAL%(A,1)=R*32+31*SGN(R):PAL%(A,2)=B*64+63*SGN(B):A=A+1:NEXT:NEXT:NEXT:PALETTE
  874. 41020 RETURN
  875. 41030 *PALETTE_CHANGE
  876. 41040 FOR A=0 TO 255:PALETTE A,[PAL%(A,0),PAL%(A,1),PAL%(A,2)]:NEXT:RETURN
  877. 41060 *PAL_SHIFT:IF PALF=0 THEN RETURN ELSE IF STP=0 THEN STP=1
  878. 41070 FOR A=PST TO 254 STEP 32
  879. 41080  G=PAL%(A,0):R=PAL%(A,1):B=PAL%(A,2)
  880. 41090  IF (A MOD 3)=PCHG THEN SWAP G,R:SWAP B,R:GOTO 41160 ELSE G=G+GAV%(A):R=R+RAV%(A):B=B+BAV%(A)
  881. 41100  IF G>255 THEN G=255:GAV%(A)=-1*STP
  882. 41110  IF G<0 THEN G=1:GAV%(A)=1*STP
  883. 41120  IF R>255 THEN R=254:RAV%(A)=-1*STP
  884. 41130  IF R<0 THEN R=0:RAV%(A)=1*STP
  885. 41140  IF B>255 THEN B=254:BAV%(A)=-1*STP
  886. 41150  IF B<0 THEN B=1:BAV%(A)=1*STP
  887. 41160  PAL%(A,0)=G:PAL%(A,1)=R:PAL%(A,2)=B:PALETTE A,[G,R,B],NZF
  888. 41170 NEXT:PST=PST+1:IF PST>31 THEN PST=1
  889. 41180 PCHG=PCHG+1:IF PCHG>2 THEN PCHG=0
  890. 41190 RETURN
  891. 41500 *GET_PALETTE
  892. 41510 FOR A=0 TO 255:OUT &HFD90,A:PAL%(A,2)=INP(&HFD92):PAL%(A,1)=INP(&HFD94):PAL%(A,0)=INP(&HFD96):NEXT:FOR A=0 TO 255:FOR I=0 TO 2:PALO%(A,I)=PAL%(A,I):NEXT:NEXT:RETURN
  893. 42000 *PAL_INI_ORG
  894. 42010 FOR A=0 TO 255:PALETTE A,[PALO%(A,0),PALO%(A,1),PALO%(A,2)]:FOR I=0 TO 2:PAL%(A,I)=PALO%(A,I):NEXT:NEXT
  895. 42020 RETURN
  896. 60000 *FILE_DIALOG:ON ERROR GOTO *エラー処理
  897. 60010 ON RIFLG+1 GOTO *RADBUT_IN0,*RADBUT_IN1,*RADBUT_IN2
  898. 60020 *RADBUT_IN0
  899. 60030 GOSUB *CDGETT:GET@A (0,0)-(639,511),GB%:SCREEN@ 0:CONSOLE 0,25:COLOR 7,,,0:CLS:PALETTE
  900. 60040 MOUSE 0:MOUSE 1,FDXM+200,FDYM+320,1:MOUSE 4,FDXM+25,FDYM-4,FDXM+320,FDYM+349
  901. 60050 LOCATE FDX+21-(LEN(TM$)\2),FDY:PRINT TM$:LOCATE FDX+22,FDY+15:PRINT "実行  取消":LOCATE FDX+30,FDY+1:PRINT "    0KB":LOCATE FDX+22,FDY+4:PRINT "親"
  902. 60060 LOCATE FDX+22,FDY+5:PRINT "↑":LOCATE FDX+22,FDY+13:PRINT "↓":LOCATE FDX+6,FDY+2:PRINT "《　 Ｑ　 》"
  903. 60070 LINE(FDXM+25,FDYM-4)-(FDXM+320,FDYM+349),PSET,0,BF,%8:LINE(FDXM+25,FDYM-4)-(FDXM+320,FDYM+349),PSET,0,BF,%8:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,B
  904. 60080 LINE(FDXM+38,FDYM+283)-(FDXM+153,FDYM+302),PSET,7,B:LINE(FDXM+38,FDYM+74)-(FDXM+153,FDYM+92),PSET,7,B:LINE(FDXM+39,FDYM+26)-(FDXM+153,FDYM+64),PSET,7,B
  905. 60090 LINE(FDXM+172,FDYM+282)-(FDXM+209,FDYM+302),PSET,7,B:LINE(FDXM+220,FDYM+282)-(FDXM+257,FDYM+302),PSET,7,B:LINE(FDXM+236,FDYM+16)-(FDXM+297,FDYM+36),PSET,7,B
  906. 60100 LINE(FDXM+172,FDYM+74)-(FDXM+194,FDYM+92),PSET,7,B:LINE(FDXM+172,FDYM+94)-(FDXM+194,FDYM+112),PSET,7,B:LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,B
  907. 60110 LINE(FDXM+172,FDYM+245)-(FDXM+194,FDYM+264),PSET,7,B:LINE(FDXM+76,FDYM+26)-(FDXM+116,FDYM+64),PSET,7,B
  908. 60120 GOSUB *PUT_FDMES
  909. 60130 *初期化
  910. 60140 MOFF=0
  911. 60150 RESTORE *CLICK_AREA
  912. 60160 FOR I=1 TO MAXCMD
  913. 60170     FOR J=1 TO 4
  914. 60180         READ XY(I,J)
  915. 60190     NEXT J
  916. 60200 NEXT I
  917. 60210 *RADBUT_IN1
  918. 60220 GOSUB *RADIO_BUTTON
  919. 60230 GOSUB *接続ドライブ
  920. 60240 GOSUB *GETCD
  921. 60250 GOSUB *DRV_HYO
  922. 60260 GOSUB *GETDIR
  923. 60270 IF RET&=-1 THEN GOSUB *NOT_DRV:GOTO *FD_MAIN_LOOP
  924. 60280 GOSUB *SEARCH
  925. 60290 GOSUB *DISK_FREE
  926. 60300 GOSUB *SORT
  927. 60310 F_NUM=1
  928. 60320 GOSUB *HYOUJI
  929. 60330 *RADBUT_IN2:FDFLG=0
  930. 60340 *FD_MAIN_LOOP
  931. 60350 MX=MOUSE(0)-FDXM:MY=MOUSE(1)-FDYM
  932. 60360 J=0:A$=INKEY$:IF A$=CHR$(13) THEN J=CANCMD-1 ELSE IF A$=CHR$(24) THEN J=CANCMD
  933. 60370 FOR I=1 TO MAXCMD
  934. 60380     IF MOUSE(2,0) AND MX>XY(I,1) AND MX<XY(I,3) THEN IF MY>XY(I,2) AND MY<XY(I,4) THEN J=I:I=100
  935. 60390 NEXT I
  936. 60400 IF J THEN *ON_MOUSE
  937. 60410 GOTO *FD_MAIN_LOOP
  938. 60420 *ON_MOUSE
  939. 60430 IF MOFF AND J>3 AND J<>CANCMD AND J<>BUTCMD THEN *FD_MAIN_LOOP
  940. 60440 ON J GOSUB *ON_LEFT,*ON_DRV,*ON_RIGHT,*ON_OYA,*ON_LIST,*ON_UP,*ON_DOWN,*ON_RUN,*ON_CANCEL,*ON_INPUT,*ON_SCROLL_BAR,*ON_BUTTON
  941. 60450 GOTO *FD_MAIN_LOOP
  942. 60460 *ON_LEFT
  943. 60470 MOFF=1
  944. 60480 GOSUB *LEFT_DRV
  945. 60490 GOSUB *DRV_HYO
  946. 60500 GOSUB *HYOUJI:WAIT 10
  947. 60510 RETURN
  948. 60520 *ON_DRV
  949. 60530 WHILE MOUSE(2,0)<>0:WEND
  950. 60540 MOFF=0
  951. 60550 FILENAME$=""
  952. 60560 GOSUB *HYOUJI_SPC
  953. 60570 GOSUB *DRV_SENTAKU
  954. 60580 RETURN
  955. 60590 *ON_RIGHT
  956. 60600 MOFF=1
  957. 60610 GOSUB *RIGHT_DRV
  958. 60620 GOSUB *DRV_HYO
  959. 60630 GOSUB *HYOUJI:WAIT 10
  960. 60640 RETURN
  961. 60650 *ON_UP
  962. 60660 IF F_NUM>1 THEN F_NUM=F_NUM-1:GOSUB *HYOUJI
  963. 60670 RETURN
  964. 60680 *ON_DOWN
  965. 60690 IF F_NUM<F_S-8 THEN F_NUM=F_NUM+1:GOSUB *HYOUJI
  966. 60700 RETURN
  967. 60710 *ON_OYA
  968. 60720 WHILE MOUSE(2,0)<>0:WEND
  969. 60730 DUMMYY$=SPACE$(14):DUMMYP$="."+CHR$(0)
  970. 60740 A=CALLM (OFFSET&,0,VARPTR(DUMMYP$),VARPTR(DUMMYY$),&H10,0)
  971. 60750 IF A=0 THEN SHELL "CD .."
  972. 60760 GOSUB *ON_DRV
  973. 60770 RETURN
  974. 60780 *ON_LIST
  975. 60790 I=0
  976. 60800 IF F_S<9 THEN K=F_S ELSE K=9
  977. 60810 IF K=0 OR FILE_SU=-1 THEN RETURN
  978. 60820 FOR J=1 TO K
  979. 60830     IF MY<95+19*J THEN I=J:J=10
  980. 60840 NEXT J
  981. 60850 IF I THEN GOSUB *SETFILE
  982. 60860 RETURN
  983. 60870 *SETFILE
  984. 60880 FILENAME$=MID$(FILE_NAME$(F_NUM+I-1+ROOT),2,14)
  985. 60890 IF ASC(FILENAME$)=60 THEN *SETDIR
  986. 60900 GOSUB *HYOUJI
  987. 60910 COLOR ,,,5:LOCATE FDX+5,FDY+4+I:PRINT " "+FNFF$(MID$(FILENAME$,2,12))+" ":COLOR 7,,,0
  988. 60920 LOCATE FDX+6,FDY+15:PRINT MID$(FILENAME$,2,12)
  989. 60930 RETURN
  990. 60940 *SETDIR
  991. 60950 DIR$=MID$(FILENAME$,2,12)
  992. 60960 GOSUB *CDDIRMOVE
  993. 60970 GOSUB *ON_DRV
  994. 60980 RETURN
  995. 60990 *ON_RUN
  996. 61000 IF LEFT$(MID$(FILENAME$,2,12)+SPACE$(12),12)=SPACE$(12) THEN RETURN ELSE FDFLG=1
  997. 61010 DRIVE$=MID$(DRV_SET$,DRV_NO,1)+":":PATH$=LEFT$(DIR$,INSTR(DIR$+" "," ")-1):F_NAME$=MID$(FILENAME$,2,12):F_NAME$=LEFT$(F_NAME$,INSTR(F_NAME$+" "," ")-1)
  998. 61020 RETURN *RET_RET
  999. 61030 *ON_CANCEL
  1000. 61040 FDFLG=0
  1001. 61050 RETURN *RET_RET
  1002. 61060 *RET_RET:RIFLG=0:SCREEN@ 2:CLS:GOSUB *VW0:PUT@A (0,0)-(639,511),GB%:GOSUB *PALETTE_CHANGE:ON ERROR GOTO 0:RETURN
  1003. 61070 *ON_INPUT:IF RWFLG=0 THEN RETURN
  1004. 61080 FT$=MID$(FILENAME$,2,12):WHILE RIGHT$(FT$,1)=" ":FT$=LEFT$(FT$,LEN(FT$)-1):WEND
  1005. 61090 CP=LEN(FT$):FLAG=0
  1006. 61100 K$=""
  1007. 61110 WHILE K$<>CHR$(13)
  1008. 61120   CP=LEN(FT$):LINE(FDXM+40,FDYM+284)-(FDXM+152,FDYM+301),PSET,1,BF:LINE ((FDX+6+CP)*8+1,FDYM+285)-((FDX+6+CP)*8+1,FDYM+300),PSET,2
  1009. 61130     K$=INPUT$(1)
  1010. 61140     IF K$=CHR$(8) OR K$=CHR$(29) THEN GOSUB *IN_DEL_LAST_C:GOTO *IN_PUT
  1011. 61150     IF K$<CHR$(33) THEN *P_SKP ELSE FT$=FT$+K$
  1012. 61160     CP=LEN(FT$):IF CP>12 THEN BEEP:FT$=LEFT$(FT$,12):CP=12:GOTO *P_SKP
  1013. 61170     IF INSTR(FT$,".")>9 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
  1014. 61180     IF CP=9 AND INSTR(FT$,".")<2 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
  1015. 61190     IF CP>INSTR(FT$,".")+3 AND INSTR(FT$,".")>1 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
  1016. 61200   *IN_PUT
  1017. 61210    LOCATE FDX+6,FDY+15:PRINT LEFT$(FT$+"            ",12)+" "
  1018. 61220   *P_SKP
  1019. 61230 WEND
  1020. 61240 LINE(FDXM+40,FDYM+284)-(FDXM+152,FDYM+301),PSET,%8,BF
  1021. 61250 FILENAME$="F"+LEFT$(FT$+"            ",12)+CHR$(0)
  1022. 61260 RETURN
  1023. 61270 *IN_DEL_LAST
  1024. 61280 CP=LEN(FT$)-1:BEEP:FT$=LEFT$(FT$,CP):RETURN
  1025. 61290 *IN_DEL_LAST_C
  1026. 61300 IF LEN(FT$)=0 THEN BEEP:RETURN ELSE FT$=KLEFT$(FT$,KLEN(FT$)-1):CP=LEN(FT$):RETURN
  1027. 61310 *ON_BUTTON
  1028. 61320 OCMD=RCMD:RCMD=((MY-76)\19)+1
  1029. 61330 IF RCMD>RADBUT THEN RCMD=OCMD:RETURN
  1030. 61340 GOSUB *DISP_RADIO
  1031. 61350 IF RETFLG(RCMD-1)=0 THEN RETURN ELSE RETURN *RADBUTRET
  1032. 61360 *RADBUTRET
  1033. 61370 FDFLG=2:RETURN
  1034. 61380 *RADIO_BUTTON:IF RADBUT=0 THEN RETURN
  1035. 61390 GOSUB *DISP_RADIO
  1036. 61400 FOR I=0 TO RADBUT-1
  1037. 61410   LOCATE FDX+27,FDY+4+I:PRINT RADBUT$(I)
  1038. 61420 NEXT
  1039. 61430 RETURN
  1040. 61440 *DISP_RADIO:IF RADBUT=0 THEN RETURN
  1041. 61450 FOR I=0 TO RADBUT-1
  1042. 61460   LOCATE FDX+25,FDY+4+I:PRINT "○";
  1043. 61470 NEXT
  1044. 61480 IF RCMD<>0 THEN  LOCATE FDX+25,FDY+3+RCMD:PRINT "●";
  1045. 61490 RETURN
  1046. 61500 *SCROLL_BAR
  1047. 61510 LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,BF,%8
  1048. 61520 IF MOFF=1 OR F_S<10 THEN IF MOFF=1 THEN RETURN ELSE LINE(FDXM+173,FDYM+113)-(FDXM+193,FDYM+244),PSET,0,BF,%15:RETURN
  1049. 61530 BOX_Y1=BOX_S!*(F_NUM-1):BOX_Y2=130-(BOX_Y1+BOX_RH)
  1050. 61540 IF BOX_Y2<0 THEN BOX_Y2=0
  1051. 61550 IF BOX_Y1>B_MAX THEN BOX_Y1=B_MAX
  1052. 61560 LINE (FDXM+173,FDYM+113+BOX_Y1)-(FDXM+193,FDYM+244-BOX_Y2),PSET,0,BF,%15
  1053. 61570 RETURN
  1054. 61580 *ON_SCROLL_BAR
  1055. 61590 IF MOFF=1 OR F_S<10 THEN RETURN
  1056. 61600 IF F_S<9 THEN F_NUM_HYO=FILE_SU ELSE F_NUM_HYO=F_NUM+8+ROOT
  1057. 61610 IF ( ROOT=2 AND F_NUM_HYO=2 ) OR FILE_SU=0 THEN RETURN
  1058. 61620 IF MY<BOX_Y1+113 OR MY>244-BOX_Y2 THEN B_Y1=(MY-113-(BOX_RH/2)):GOTO *SCROLL_CLICK ELSE OI=257
  1059. 61630 WHILE MOUSE(2,0)<>0:MY=MOUSE(1)-FDYM:B_Y1=(MY-113-(BOX_RH/2)):OI=I:I=B_Y1/BOX_S!
  1060. 61640   IF I<0 THEN I=0
  1061. 61650   IF I>F_S-9 THEN I=F_S-9
  1062. 61660   I=I+1:B_Y1=BOX_S!*(I-1):B_Y2=130-(B_Y1+BOX_RH)
  1063. 61670   IF B_Y2<0 THEN B_Y2=0
  1064. 61680   IF B_Y1>B_MAX THEN B_Y1=B_MAX
  1065. 61690   IF OI<>I THEN LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,BF,%8:LINE (FDXM+173,FDYM+113+B_Y1)-(FDXM+193,FDYM+244-B_Y2),PSET,0,BF,%15
  1066. 61700 WEND:GOTO *SCROLL_RET
  1067. 61710 *SCROLL_CLICK:I=B_Y1/BOX_S!
  1068. 61720 IF I<0 THEN I=0
  1069. 61730 IF I>F_S-9 THEN I=F_S-9
  1070. 61740 I=I+1
  1071. 61750 *SCROLL_RET
  1072. 61760 F_NUM=I:GOSUB *HYOUJI
  1073. 61770 RETURN
  1074. 61780 *LEFT_DRV
  1075. 61790 DRV_NO=DRV_NO-1
  1076. 61800 IF DRV_NO=0 THEN DRV_NO=DRV_SU
  1077. 61810 RETURN
  1078. 61820 *RIGHT_DRV
  1079. 61830 DRV_NO=DRV_NO+1
  1080. 61840 IF DRV_NO>DRV_SU THEN DRV_NO=1
  1081. 61850 RETURN
  1082. 61860 *DRV_SENTAKU
  1083. 61870 F_NUM=1
  1084. 61880 GOSUB *CDMOVE
  1085. 61890 GOSUB *GETDIR
  1086. 61900 IF RET&=-1 THEN GOSUB *NOT_DRV:RETURN
  1087. 61910 GOSUB *SEARCH
  1088. 61920 GOSUB *DISK_FREE
  1089. 61930 GOSUB *SORT
  1090. 61940 GOSUB *HYOUJI
  1091. 61950 RETURN
  1092. 61960 *GETCD
  1093. 61970 DMMY$=CHR$(CALLM (OFFSET&,1))
  1094. 61980 DRV_NO=INSTR(1,DRV_SET$,DMMY$)
  1095. 61990 RETURN
  1096. 62000 *GETDIR
  1097. 62010 DMMY$=MID$(DRV_SET$,DRV_NO,1)
  1098. 62020 DIR$=SPACE$(65)
  1099. 62030 RET&=CALLM(OFFSET&,2,ASC(DMMY$),VARPTR(DIR$))
  1100. 62040 I=KINSTR(DIR$,"\")
  1101. 62050 J=I
  1102. 62060 WHILE I
  1103. 62070       J=I
  1104. 62080       I=KINSTR(J+1,DIR$,"\") 
  1105. 62090 WEND
  1106. 62100 LOCATE FDX+6,FDY+4:PRINT KMID$(DIR$,J+1,12)
  1107. 62110 RETURN
  1108. 62120 *CDMOVE
  1109. 62130 DMMY$=MID$(DRV_SET$,DRV_NO,1)
  1110. 62140 SHELL DMMY$+":":
  1111. 62150 RETURN
  1112. 62160 *CDDIRMOVE
  1113. 62170 DIR$=DIR$+CHR$(0)
  1114. 62180 CALLM OFFSET&,4,VARPTR(DIR$)
  1115. 62190 RETURN
  1116. 62200 *SEARCH:A&=FRE(1):LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,BF,%1':IF BASCOM=1 THEN *SEARCH_COM
  1117. 62210 GOSUB *SEARCH_DIR
  1118. 62220 PATH_ALL$=WC$+CHR$(0)
  1119. 62230 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(FILE_SU+1)),0,0)
  1120. 62240 IF A<>0 THEN RETURN ELSE FILE_SU=FILE_SU+1
  1121. 62250 FILE_NAME$(FILE_SU)="2 "+MID$(FILE_NAME$(FILE_SU),2,12)+" "
  1122. 62260 FOR I=FILE_SU+1 TO 256
  1123. 62270     A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),0,1)
  1124. 62280     IF A<>0 THEN FILE_SU=I-1:I=257:GOTO *LOOPOUT ELSE FILE_SU=I
  1125. 62290     KAKUNO$=FILE_NAME$(I)
  1126. 62300     FILE_NAME$(I)="2 "+MID$(KAKUNO$,2,12)+" "
  1127. 62310 *LOOPOUT
  1128. 62320 NEXT I
  1129. 62330 RETURN
  1130. 62340 *SEARCH_DIR
  1131. 62350 PATH_ALL$="*.*"+CHR$(0)
  1132. 62360 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(1)),&H10,0)
  1133. 62370 ROOT=0:FILE_SU=0
  1134. 62380 IF A<>0 THEN RETURN ELSE FILE_SU=2
  1135. 62390 IF KMID$(FILE_NAME$(1),2,1)="." THEN ROOT=2
  1136. 62400 IF ASC(FILE_NAME$(1))=68 THEN FILE_NAME$(1)="1<"+MID$(FILE_NAME$(1),2,12)+">" ELSE FILE_SU=1
  1137. 62410 FOR I=FILE_SU TO 256
  1138. 62420     A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),&H10,1)
  1139. 62430     IF A<>0 THEN FILE_SU=I-1:I=257:GOTO *LOOPOUTD ELSE FILE_SU=I
  1140. 62440     KAKUNO$=FILE_NAME$(I)
  1141. 62450     IF ASC(KAKUNO$)=68 THEN FILE_NAME$(I)="1<"+MID$(KAKUNO$,2,12)+">" ELSE I=I-1
  1142. 62460 *LOOPOUTD
  1143. 62470 NEXT I
  1144. 62480 RETURN
  1145. 62820 *SORT
  1146. 62830 I=FILE_SU\2
  1147. 62840 J=1:FLG=0
  1148. 62850 *SORT1
  1149. 62860 IF J+I>FILE_SU THEN IF FLG=1 THEN J=1:FLG=0 ELSE I=I\2:J=1:FLG=0:IF I=0 THEN *SCROLL_CALC
  1150. 62870 IF FILE_NAME$(J)>FILE_NAME$(J+I) THEN SWAP FILE_NAME$(J),FILE_NAME$(J+I):FLG=1
  1151. 62880 J=J+1
  1152. 62890 GOTO *SORT1
  1153. 62900 *SCROLL_CALC
  1154. 62910 F_S=FILE_SU-ROOT:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,BF,%8
  1155. 62920 IF F_S<10 THEN BOX_S!=1:BOX_RH=0:BOX_H=130:B_MAX=243:RETURN
  1156. 62930 BOX_S!=130/F_S:BOX_SS!=130/(F_S-9)
  1157. 62940 BOX_RH=BOX_S!*9:BOX_H=130-BOX_RH:B_MAX=113+BOX_H
  1158. 62950 RETURN
  1159. 62960 *HYOUJI
  1160. 62970 GOSUB *SCROLL_BAR:IF MOFF=1 THEN COLOR 1 ELSE COLOR 7
  1161. 62980 IF F_S<9 THEN F_NUM_HYO=FILE_SU ELSE F_NUM_HYO=F_NUM+8+ROOT
  1162. 62990 IF ( ROOT=2 AND F_NUM_HYO=2 ) OR FILE_SU=0 THEN *HYOUJI_RET
  1163. 63000 FOR J=F_NUM+ROOT TO F_NUM_HYO
  1164. 63010     LOCATE FDX+5,FDY+5+J-(F_NUM+ROOT):IF LEFT$(FILE_NAME$(J),1)="1" THEN PRINT MID$(FILE_NAME$(J),2,14) ELSE PRINT " "+FNFF$(MID$(FILE_NAME$(J),3,12))+" "
  1165. 63020 NEXT J
  1166. 63030 *HYOUJI_RET
  1167. 63040 COLOR 7:RETURN
  1168. 63050 *HYOUJI_SPC
  1169. 63060 FOR J=0 TO 8
  1170. 63070     LOCATE FDX+5,FDY+5+J:PRINT SPC(14)
  1171. 63080 NEXT J
  1172. 63090 LOCATE FDX+6,FDY+15:PRINT SPC(12)
  1173. 63100 RETURN
  1174. 63110 *DRV_HYO
  1175. 63120 LOCATE FDX+11,FDY+2:PRINT AKCNV$(MID$(DRV_SET$,DRV_NO,1))
  1176. 63130 '
  1177. 63140 '
  1178. 63150 RETURN
  1179. 63160 *DISK_FREE
  1180. 63170 DFREE&=0
  1181. 63180 DFREE&=DSKF(ASC(MID$(DRV_SET$,DRV_NO,1))-ASC("A"))
  1182. 63190 LOCATE FDX+30,FDY+1:IF DFREE&<1024 THEN PRINT USING "#,###KB";DFREE& ELSE PRINT USING "###.#MB";DFREE&/1024 
  1183. 63200 RETURN
  1184. 63210 *接続ドライブ
  1185. 63220 DRV_SET$=""
  1186. 63230 J=0:A&=0
  1187. 63240 INFOR$=STRING$(200,0)
  1188. 63250 CALLM OFFSET&,7,VARPTR(INFOR$)
  1189. 63260 A&=PEEK(VARPTR(INFOR$),4)
  1190. 63270 FOR I&=&H30 TO &H4F STEP 2
  1191. 63280      IF PEEK(A&+I&)<>255 THEN DRV_SET$=DRV_SET$+CHR$(&H41+J)
  1192. 63290  J=J+1
  1193. 63300 NEXT
  1194. 63310 DRV_SET$=DRV_SET$+"Q"
  1195. 63320 DRV_SU=LEN(DRV_SET$)
  1196. 63330 RETURN
  1197. 63340 *PUT_FDMES
  1198. 63350 FDMT$=LEFT$(FDM$,68):IF LEN(FDMT$)=68 THEN IF KTYPE(FDM$,KLEN(FDMT$))=1 THEN FDMT$=LEFT$(FDM$,67)
  1199. 63360 LOCATE FDX+4,FDY+16:PRINT SPC(40):LOCATE FDX+4,FDY+17:PRINT SPC(40)
  1200. 63370 LOCATE FDX+4,FDY+16
  1201. 63380 WHILE LEN(FDMT$)>0
  1202. 63390  IF KTYPE(FDMT$,1)=1 AND POS(0)=FDX+37 THEN PRINT " ";
  1203. 63400  IF POS(0)>FDX+37 THEN LOCATE FDX+4,FDY+17:IF LEN(FDMT$)>34 THEN IF KTYPE(FDMT$,KLEN(FDMT$))=1 THEN FDMT$=KLEFT$(FDMT$,KLEN(FDMT$)-1) ELSE FDMT$=LEFT$(FDMT$,34)
  1204. 63410  PRINT KLEFT$(FDMT$,1);:IF LEN(FDMT$)<>0 THEN FDMT$=KRIGHT$(FDMT$,KLEN(FDMT$)-1)
  1205. 63420 WEND
  1206. 63430 COLOR 7,,,0
  1207. 63440 RETURN
  1208. 63450 *NOT_DRV
  1209. 63460 BEEP:M$="指定されたディスク装置が使用可能な状態になっていません"
  1210. 63470 COLOR 2,,,4
  1211. 63480 SWAP FDM$,M$:GOSUB *PUT_FDMES
  1212. 63490 WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:WEND
  1213. 63500 SWAP FDM$,M$:GOSUB *PUT_FDMES
  1214. 63510 FILE_SU=0
  1215. 63520 ROOT=0
  1216. 63530 MOFF=1
  1217. 63540 RETURN
  1218. 63550 *エラー処理
  1219. 63560 IF ERR=72 THEN GOSUB *NOT_DRV
  1220. 63570 RESUME NEXT
  1221. 63580 *CLICK_AREA
  1222. 63590 DATA  41, 26,76 , 64
  1223. 63600 DATA  76, 26,116, 64
  1224. 63610 DATA 116, 26,153, 64
  1225. 63620 DATA 172, 74,194, 92
  1226. 63630 DATA  38, 93,153,264
  1227. 63640 DATA 172, 94,194,112
  1228. 63650 DATA 172,245,194,264
  1229. 63660 DATA 172,282,209,304
  1230. 63670 DATA 220,282,257,304
  1231. 63680 DATA  38,283,153,302
  1232. 63690 DATA 172,112,194,245
  1233. 63700 DATA 198, 74,311,264
  1234.